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