1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
#' Evenly spaced colours for discrete data
#'
#' Maps each level to an evenly spaced hue on the colour wheel.
#' It does not generate colour-blind safe palettes.
#'
#' @param na.value Colour to use for missing values
#' @inheritDotParams discrete_scale -aesthetics
#' @param aesthetics Character string or vector of character strings listing the
#' name(s) of the aesthetic(s) that this scale works with. This can be useful, for
#' example, to apply colour settings to the `colour` and `fill` aesthetics at the
#' same time, via `aesthetics = c("colour", "fill")`.
#' @inheritParams scales::hue_pal
#' @rdname scale_hue
#' @export
#' @family colour scales
#' @examples
#' \donttest{
#' set.seed(596)
#' dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
#' (d <- ggplot(dsamp, aes(carat, price)) + geom_point(aes(colour = clarity)))
#'
#' # Change scale label
#' d + scale_colour_hue()
#' d + scale_colour_hue("clarity")
#' d + scale_colour_hue(expression(clarity[beta]))
#'
#' # Adjust luminosity and chroma
#' d + scale_colour_hue(l = 40, c = 30)
#' d + scale_colour_hue(l = 70, c = 30)
#' d + scale_colour_hue(l = 70, c = 150)
#' d + scale_colour_hue(l = 80, c = 150)
#'
#' # Change range of hues used
#' d + scale_colour_hue(h = c(0, 90))
#' d + scale_colour_hue(h = c(90, 180))
#' d + scale_colour_hue(h = c(180, 270))
#' d + scale_colour_hue(h = c(270, 360))
#'
#' # Vary opacity
#' # (only works with pdf, quartz and cairo devices)
#' d <- ggplot(dsamp, aes(carat, price, colour = clarity))
#' d + geom_point(alpha = 0.9)
#' d + geom_point(alpha = 0.5)
#' d + geom_point(alpha = 0.2)
#'
#' # Colour of missing values is controlled with na.value:
#' miss <- factor(sample(c(NA, 1:5), nrow(mtcars), replace = TRUE))
#' ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(colour = miss))
#' ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(colour = miss)) +
#' scale_colour_hue(na.value = "black")
#' }
scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1, na.value = "grey50", aesthetics = "colour") {
discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction),
na.value = na.value, ...)
}
#' @rdname scale_hue
#' @export
scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1, na.value = "grey50", aesthetics = "fill") {
discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction),
na.value = na.value, ...)
}
#' Discrete colour scales
#'
#' The default discrete colour scale. Defaults to [scale_fill_hue()]/[scale_fill_brewer()]
#' unless `type` (which defaults to the `ggplot2.discrete.fill`/`ggplot2.discrete.colour` options)
#' is specified.
#'
#' @param ... Additional parameters passed on to the scale type,
#' @param type One of the following:
#' * A character vector of color codes. The codes are used for a 'manual' color
#' scale as long as the number of codes exceeds the number of data levels
#' (if there are more levels than codes, [scale_colour_hue()]/[scale_fill_hue()]
#' are used to construct the default scale). If this is a named vector, then the color values
#' will be matched to levels based on the names of the vectors. Data values that
#' don't match will be set as `na.value`.
#' * A list of character vectors of color codes. The minimum length vector that exceeds the
#' number of data levels is chosen for the color scaling. This is useful if you
#' want to change the color palette based on the number of levels.
#' * A function that returns a discrete colour/fill scale (e.g., [scale_fill_hue()],
#' [scale_fill_brewer()], etc).
#' @export
#' @examples
#' # Template function for creating densities grouped by a variable
#' cty_by_var <- function(var) {
#' ggplot(mpg, aes(cty, colour = factor({{var}}), fill = factor({{var}}))) +
#' geom_density(alpha = 0.2)
#' }
#'
#' # The default, scale_fill_hue(), is not colour-blind safe
#' cty_by_var(class)
#'
#' # (Temporarily) set the default to Okabe-Ito (which is colour-blind safe)
#' okabe <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
#' withr::with_options(
#' list(ggplot2.discrete.fill = okabe),
#' print(cty_by_var(class))
#' )
#'
#' # Define a collection of palettes to alter the default based on number of levels to encode
#' discrete_palettes <- list(
#' c("skyblue", "orange"),
#' RColorBrewer::brewer.pal(3, "Set2"),
#' RColorBrewer::brewer.pal(6, "Accent")
#' )
#' withr::with_options(
#' list(ggplot2.discrete.fill = discrete_palettes), {
#' # 1st palette is used when there 1-2 levels (e.g., year)
#' print(cty_by_var(year))
#' # 2nd palette is used when there are 3 levels
#' print(cty_by_var(drv))
#' # 3rd palette is used when there are 4-6 levels
#' print(cty_by_var(fl))
#' })
#'
scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour")) {
# TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
type <- type %||% scale_colour_hue
if (is.function(type)) {
check_scale_type(
type(...),
"scale_colour_discrete",
"colour",
scale_is_discrete = TRUE
)
} else {
scale_colour_qualitative(..., type = type)
}
}
#' @rdname scale_colour_discrete
#' @export
scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) {
# TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
type <- type %||% scale_fill_hue
if (is.function(type)) {
check_scale_type(
type(...),
"scale_fill_discrete",
"fill",
scale_is_discrete = TRUE
)
} else {
scale_fill_qualitative(..., type = type)
}
}
scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1, na.value = "grey50", aesthetics = "colour") {
discrete_scale(
aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction),
na.value = na.value, ...
)
}
scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1, na.value = "grey50", aesthetics = "fill") {
discrete_scale(
aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction),
na.value = na.value, ...
)
}
#' Given set(s) of colour codes (i.e., type), find the smallest set that can support n levels
#' @param type a character vector or a list of character vectors
#' @noRd
qualitative_pal <- function(type, h, c, l, h.start, direction) {
function(n) {
type_list <- if (!is.list(type)) list(type) else type
if (!all(vapply(type_list, is.character, logical(1)))) {
cli::cli_abort("{.arg type} must be a character vector or a list of character vectors")
}
type_lengths <- vapply(type_list, length, integer(1))
# If there are more levels than color codes default to hue_pal()
if (max(type_lengths) < n) {
return(scales::hue_pal(h, c, l, h.start, direction)(n))
}
# Use the minimum length vector that exceeds the number of levels (n)
type_list <- type_list[order(type_lengths)]
i <- 1
while (length(type_list[[i]]) < n) {
i <- i + 1
}
type_list[[i]][seq_len(n)]
}
}
|
