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
|
#' Create your own discrete scale
#'
#' These functions allow you to specify your own set of mappings from levels in the
#' data to aesthetic values.
#'
#' The functions `scale_colour_manual()`, `scale_fill_manual()`, `scale_size_manual()`,
#' etc. work on the aesthetics specified in the scale name: `colour`, `fill`, `size`,
#' etc. However, the functions `scale_colour_manual()` and `scale_fill_manual()` also
#' have an optional `aesthetics` argument that can be used to define both `colour` and
#' `fill` aesthetic mappings via a single function call (see examples). The function
#' `scale_discrete_manual()` is a generic scale that can work with any aesthetic or set
#' of aesthetics provided via the `aesthetics` argument.
#'
#' @inheritParams scale_x_discrete
#' @inheritDotParams discrete_scale -expand -position -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")`.
#' @param values a set of aesthetic values to map data values to. The values
#' will be matched in order (usually alphabetical) with the limits of the
#' scale, or with `breaks` if provided. If this is a named vector, then the
#' values will be matched based on the names instead. Data values that don't
#' match will be given `na.value`.
#' @param breaks One of:
#' - `NULL` for no breaks
#' - `waiver()` for the default breaks (the scale limits)
#' - A character vector of breaks
#' - A function that takes the limits as input and returns breaks
#' as output
#' @param na.value The aesthetic value to use for missing (`NA`) values
#'
#' @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
#' color vision deficiencies. Using `viridis` type, which is perceptually
#' uniform in both colour and black-and-white display is an easy option to
#' ensure good perceptive properties of your visulizations.
#' The colorspace package offers functionalities
#' - to generate color palettes with good perceptive properties,
#' - to analyse a given color palette, like emulating color blindness,
#' - and to modify a given color palette for better perceptivity.
#'
#' For more information on color vision deficiencies and suitable color choices
#' see the [paper on the colorspace package](https://arxiv.org/abs/1903.06490)
#' and references therein.
#' @examples
#' p <- ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(colour = factor(cyl)))
#' p + scale_colour_manual(values = c("red", "blue", "green"))
#'
#' # It's recommended to use a named vector
#' cols <- c("8" = "red", "4" = "blue", "6" = "darkgreen", "10" = "orange")
#' p + scale_colour_manual(values = cols)
#'
#' # You can set color and fill aesthetics at the same time
#' ggplot(
#' mtcars,
#' aes(mpg, wt, colour = factor(cyl), fill = factor(cyl))
#' ) +
#' geom_point(shape = 21, alpha = 0.5, size = 2) +
#' scale_colour_manual(
#' values = cols,
#' aesthetics = c("colour", "fill")
#' )
#'
#' # As with other scales you can use breaks to control the appearance
#' # of the legend.
#' p + scale_colour_manual(values = cols)
#' p + scale_colour_manual(
#' values = cols,
#' breaks = c("4", "6", "8"),
#' labels = c("four", "six", "eight")
#' )
#'
#' # And limits to control the possible values of the scale
#' p + scale_colour_manual(values = cols, limits = c("4", "8"))
#' p + scale_colour_manual(values = cols, limits = c("4", "6", "8", "10"))
#' @name scale_manual
#' @aliases NULL
NULL
#' @rdname scale_manual
#' @export
scale_colour_manual <- function(..., values, aesthetics = "colour", breaks = waiver(), na.value = "grey50") {
manual_scale(aesthetics, values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_fill_manual <- function(..., values, aesthetics = "fill", breaks = waiver(), na.value = "grey50") {
manual_scale(aesthetics, values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_size_manual <- function(..., values, breaks = waiver(), na.value = NA) {
manual_scale("size", values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_shape_manual <- function(..., values, breaks = waiver(), na.value = NA) {
manual_scale("shape", values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_linetype_manual <- function(..., values, breaks = waiver(), na.value = "blank") {
manual_scale("linetype", values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_linewidth_manual <- function(..., values, breaks = waiver(), na.value = NA) {
manual_scale("linewidth", values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_alpha_manual <- function(..., values, breaks = waiver(), na.value = NA) {
manual_scale("alpha", values, breaks, ..., na.value = na.value)
}
#' @rdname scale_manual
#' @export
scale_discrete_manual <- function(aesthetics, ..., values, breaks = waiver()) {
manual_scale(aesthetics, values, breaks, ...)
}
manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ..., limits = NULL) {
# check for missing `values` parameter, in lieu of providing
# a default to all the different scale_*_manual() functions
if (is_missing(values)) {
values <- NULL
} else {
force(values)
}
if (is.null(limits) && !is.null(names(values))) {
# Limits as function to access `values` names later on (#4619)
limits <- function(x) intersect(x, names(values)) %||% character()
}
# order values according to breaks
if (is.vector(values) && is.null(names(values)) && !is.waive(breaks) &&
!is.null(breaks) && !is.function(breaks)) {
if (length(breaks) <= length(values)) {
names(values) <- breaks
} else {
names(values) <- breaks[1:length(values)]
}
}
pal <- function(n) {
if (n > length(values)) {
cli::cli_abort("Insufficient values in manual scale. {n} needed but only {length(values)} provided.")
}
values
}
discrete_scale(aesthetic, "manual", pal, breaks = breaks, limits = limits, ...)
}
|
