Skip to content

Commit 9ac9ff5

Browse files
cpsievertcpsievert
authored
Configurable qualitative color scales (#3833)
1 parent 37ed660 commit 9ac9ff5

File tree

6 files changed

+235
-19
lines changed

6 files changed

+235
-19
lines changed

‎DESCRIPTION

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ Suggests:
5656
nlme,
5757
profvis,
5858
quantreg,
59+
RColorBrewer,
5960
rgeos,
6061
rmarkdown,
6162
rpart,

‎R/scale-hue.r

Lines changed: 117 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,7 @@
11
#' Evenly spaced colours for discrete data
22
#'
3-
#' This is the default colour scale for categorical variables. It maps each
4-
#' level to an evenly spaced hue on the colour wheel. It does not generate
5-
#' colour-blind safe palettes.
3+
#' Maps each level to an evenly spaced hue on the colour wheel.
4+
#' It does not generate colour-blind safe palettes.
65
#'
76
#' @param na.value Colour to use for missing values
87
#' @inheritDotParams discrete_scale -aesthetics
@@ -63,3 +62,118 @@ scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0
6362
discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction),
6463
na.value = na.value, ...)
6564
}
65+
66+
67+
#' Discrete colour scales
68+
#'
69+
#' The default discrete colour scale. Defaults to [scale_fill_hue()]/[scale_fill_brewer()]
70+
#' unless `type` (which defaults to the `ggplot2.discrete.fill`/`ggplot2.discrete.colour` options)
71+
#' is specified.
72+
#'
73+
#' @param ... Additional parameters passed on to the scale type,
74+
#' @param type One of the following:
75+
#' * A character vector of color codes. The codes are used for a 'manual' color
76+
#' scale as long as the number of codes exceeds the number of data levels
77+
#' (if there are more levels than codes, [scale_colour_hue()]/[scale_fill_hue()]
78+
#' are used to construct the default scale).
79+
#' * A list of character vectors of color codes. The minimum length vector that exceeds the
80+
#' number of data levels is chosen for the color scaling. This is useful if you
81+
#' want to change the color palette based on the number of levels.
82+
#' * A function that returns a discrete colour/fill scale (e.g., [scale_fill_hue()],
83+
#' [scale_fill_brewer()], etc).
84+
#' @export
85+
#' @rdname
86+
#' @examples
87+
#' # Template function for creating densities grouped by a variable
88+
#' cty_by_var <- function(var) {
89+
#' ggplot(mpg, aes(cty, colour = factor({{var}}), fill = factor({{var}}))) +
90+
#' geom_density(alpha = 0.2)
91+
#' }
92+
#'
93+
#' # The default, scale_fill_hue(), is not colour-blind safe
94+
#' cty_by_var(class)
95+
#'
96+
#' # (Temporarily) set the default to Okabe-Ito (which is colour-blind safe)
97+
#' okabe <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
98+
#' withr::with_options(
99+
#' list(ggplot2.discrete.fill = okabe),
100+
#' print(cty_by_var(class))
101+
#' )
102+
#'
103+
#' # Define a collection of palettes to alter the default based on number of levels to encode
104+
#' discrete_palettes <- list(
105+
#' c("skyblue", "orange"),
106+
#' RColorBrewer::brewer.pal(3, "Set2"),
107+
#' RColorBrewer::brewer.pal(6, "Accent")
108+
#' )
109+
#' withr::with_options(
110+
#' list(ggplot2.discrete.fill = discrete_palettes), {
111+
#' # 1st palette is used when there 1-2 levels (e.g., year)
112+
#' print(cty_by_var(year))
113+
#' # 2nd palette is used when there are 3 levels
114+
#' print(cty_by_var(drv))
115+
#' # 3rd palette is used when there are 4-6 levels
116+
#' print(cty_by_var(fl))
117+
#' })
118+
#'
119+
scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour", getOption("ggplot2.discrete.fill"))) {
120+
# TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
121+
type <- type %||% scale_colour_hue
122+
if (is.function(type)) {
123+
type(...)
124+
} else {
125+
scale_colour_qualitative(..., type = type)
126+
}
127+
}
128+
129+
#' @rdname scale_colour_discrete
130+
#' @export
131+
scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill", getOption("ggplot2.discrete.colour"))) {
132+
# TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
133+
type <- type %||% scale_fill_hue
134+
if (is.function(type)) {
135+
type(...)
136+
} else {
137+
scale_fill_qualitative(..., type = type)
138+
}
139+
}
140+
141+
scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
142+
direction = 1, na.value = "grey50", aesthetics = "colour") {
143+
discrete_scale(
144+
aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction),
145+
na.value = na.value, ...
146+
)
147+
}
148+
149+
scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
150+
direction = 1, na.value = "grey50", aesthetics = "fill") {
151+
discrete_scale(
152+
aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction),
153+
na.value = na.value, ...
154+
)
155+
}
156+
157+
#' Given set(s) of colour codes (i.e., type), find the smallest set that can support n levels
158+
#' @param type a character vector or a list of character vectors
159+
#' @noRd
160+
qualitative_pal <- function(type, h, c, l, h.start, direction) {
161+
function(n) {
162+
type_list <- if (!is.list(type)) list(type) else type
163+
if (!all(vapply(type_list, is.character, logical(1)))) {
164+
abort("`type` must be a character vector or a list of character vectors", call. = FALSE)
165+
}
166+
type_lengths <- vapply(type_list, length, integer(1))
167+
# If there are more levels than color codes default to hue_pal()
168+
if (max(type_lengths) < n) {
169+
return(scales::hue_pal(h, c, l, h.start, direction)(n))
170+
}
171+
# Use the minimum length vector that exceeds the number of levels (n)
172+
type_list <- type_list[order(type_lengths)]
173+
i <- 1
174+
while (length(type_list[[i]]) < n) {
175+
i <- i + 1
176+
}
177+
type_list[[i]][seq_len(n)]
178+
}
179+
}

‎R/zxx.r

Lines changed: 1 addition & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,5 @@
11
# Default scales -------------------------------------------------------------
22

3-
#' @export
4-
#' @rdname scale_hue
5-
#' @usage NULL
6-
scale_colour_discrete <- scale_colour_hue
7-
83
#' @export
94
#' @rdname scale_viridis
105
#' @usage NULL
@@ -64,11 +59,6 @@ scale_colour_date <- function(...,
6459
#' @usage NULL
6560
scale_color_date <- scale_colour_date
6661

67-
#' @export
68-
#' @rdname scale_hue
69-
#' @usage NULL
70-
scale_fill_discrete <- scale_fill_hue
71-
7262
#' @export
7363
#' @rdname scale_viridis
7464
#' @usage NULL
@@ -143,7 +133,7 @@ scale_color_binned <- scale_colour_binned
143133
#' @export
144134
#' @rdname scale_hue
145135
#' @usage NULL
146-
scale_color_discrete <- scale_colour_hue
136+
scale_color_discrete <- scale_colour_discrete
147137

148138
#' @export
149139
#' @rdname scale_gradient

‎man/scale_colour_discrete.Rd

Lines changed: 72 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/scale_hue.Rd

Lines changed: 2 additions & 5 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-scale-discrete.R

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -87,3 +87,45 @@ test_that("discrete non-position scales can accept functional limits", {
8787
scale$train(c("a", "b", "c"))
8888
expect_identical(scale$get_limits(), c("c", "b", "a"))
8989
})
90+
91+
92+
test_that("discrete scale defaults can be set globally", {
93+
df <- data_frame(
94+
x = 1:4, y = 1:4,
95+
two = c("a", "b", "a", "b"),
96+
four = c("a", "b", "c", "d")
97+
)
98+
99+
withr::with_options(
100+
list(ggplot2.discrete.fill = c("#FFFFFF", "#000000")), {
101+
# nlevels == ncodes
102+
two <- ggplot(df, aes(x, y, colour = two, fill = two)) + geom_point()
103+
expect_equal(layer_data(two)$colour, rep(c("#FFFFFF", "#000000"), 2))
104+
expect_equal(layer_data(two)$fill, rep(c("#FFFFFF", "#000000"), 2))
105+
106+
# nlevels > ncodes (so should fallback to scale_fill_hue())
107+
four_default <- ggplot(df, aes(x, y, colour = four, fill = four)) +
108+
geom_point()
109+
four_hue <- four_default + scale_fill_hue()
110+
expect_equal(layer_data(four_default)$colour, layer_data(four_hue)$colour)
111+
})
112+
113+
withr::with_options(
114+
list(
115+
ggplot2.discrete.fill = list(
116+
c("#FFFFFF", "#000000"),
117+
c("#FF0000", "#00FF00", "#0000FF", "#FF00FF")
118+
)
119+
), {
120+
# nlevels == 2
121+
two <- ggplot(df, aes(x, y, colour = two, fill = two)) + geom_point()
122+
expect_equal(layer_data(two)$colour, rep(c("#FFFFFF", "#000000"), 2))
123+
expect_equal(layer_data(two)$fill, rep(c("#FFFFFF", "#000000"), 2))
124+
125+
# nlevels == 4
126+
four <- ggplot(df, aes(x, y, colour = four, fill = four)) + geom_point()
127+
expect_equal(layer_data(four)$colour, c("#FF0000", "#00FF00", "#0000FF", "#FF00FF"))
128+
expect_equal(layer_data(four)$fill, c("#FF0000", "#00FF00", "#0000FF", "#FF00FF"))
129+
})
130+
131+
})

0 commit comments

Comments
 (0)