1#' Gradient colour scales
2#'
3#' `scale_*_gradient` creates a two colour gradient (low-high),
4#' `scale_*_gradient2` creates a diverging colour gradient (low-mid-high),
5#' `scale_*_gradientn` creates a n-colour gradient. For binned variants of
6#' these scales, see the [color steps][scale_colour_steps] scales.
7#'
8#' Default colours are generated with \pkg{munsell} and
9#' `mnsl(c("2.5PB 2/4", "2.5PB 7/10"))`. Generally, for continuous
10#' colour scales you want to keep hue constant, but vary chroma and
11#' luminance. The \pkg{munsell} package makes this easy to do using the
12#' Munsell colour system.
13#'
14#' @inheritParams scales::seq_gradient_pal
15#' @inheritParams scale_colour_hue
16#' @param low,high Colours for low and high ends of the gradient.
17#' @param guide Type of legend. Use `"colourbar"` for continuous
18#'   colour bar, or `"legend"` for discrete colour legend.
19#' @inheritDotParams continuous_scale -na.value -guide -aesthetics
20#' @seealso [scales::seq_gradient_pal()] for details on underlying
21#'   palette, [scale_colour_steps()] for binned variants of these scales.
22#' @family colour scales
23#' @rdname scale_gradient
24#' @export
25#' @examples
26#' df <- data.frame(
27#'   x = runif(100),
28#'   y = runif(100),
29#'   z1 = rnorm(100),
30#'   z2 = abs(rnorm(100))
31#' )
32#'
33#' df_na <- data.frame(
34#'   value = seq(1, 20),
35#'   x = runif(20),
36#'   y = runif(20),
37#'   z1 = c(rep(NA, 10), rnorm(10))
38#' )
39#'
40#' # Default colour scale colours from light blue to dark blue
41#' ggplot(df, aes(x, y)) +
42#'   geom_point(aes(colour = z2))
43#'
44#' # For diverging colour scales use gradient2
45#' ggplot(df, aes(x, y)) +
46#'   geom_point(aes(colour = z1)) +
47#'   scale_colour_gradient2()
48#'
49#' # Use your own colour scale with gradientn
50#' ggplot(df, aes(x, y)) +
51#'   geom_point(aes(colour = z1)) +
52#'   scale_colour_gradientn(colours = terrain.colors(10))
53#'
54#' # Equivalent fill scales do the same job for the fill aesthetic
55#' ggplot(faithfuld, aes(waiting, eruptions)) +
56#'   geom_raster(aes(fill = density)) +
57#'   scale_fill_gradientn(colours = terrain.colors(10))
58#'
59#' # Adjust colour choices with low and high
60#' ggplot(df, aes(x, y)) +
61#'   geom_point(aes(colour = z2)) +
62#'   scale_colour_gradient(low = "white", high = "black")
63#' # Avoid red-green colour contrasts because ~10% of men have difficulty
64#' # seeing them
65#'
66#'# Use `na.value = NA` to hide missing values but keep the original axis range
67#' ggplot(df_na, aes(x = value, y)) +
68#'   geom_bar(aes(fill = z1), stat = "identity") +
69#'   scale_fill_gradient(low = "yellow", high = "red", na.value = NA)
70#'
71#'  ggplot(df_na, aes(x, y)) +
72#'    geom_point(aes(colour = z1)) +
73#'    scale_colour_gradient(low = "yellow", high = "red", na.value = NA)
74#'
75scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
76                                  na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
77  continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space),
78    na.value = na.value, guide = guide, ...)
79}
80
81#' @rdname scale_gradient
82#' @export
83scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
84                                na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
85  continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space),
86    na.value = na.value, guide = guide, ...)
87}
88
89#' @inheritParams scales::div_gradient_pal
90#' @param midpoint The midpoint (in data value) of the diverging scale.
91#'   Defaults to 0.
92#' @rdname scale_gradient
93#' @export
94scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
95                                   midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
96                                   aesthetics = "colour") {
97  continuous_scale(aesthetics, "gradient2",
98    div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ...,
99    rescaler = mid_rescaler(mid = midpoint))
100}
101
102#' @rdname scale_gradient
103#' @export
104scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
105                                 midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
106                                 aesthetics = "fill") {
107  continuous_scale(aesthetics, "gradient2",
108    div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ...,
109    rescaler = mid_rescaler(mid = midpoint))
110}
111
112mid_rescaler <- function(mid) {
113  function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) {
114    rescale_mid(x, to, from, mid)
115  }
116}
117
118#' @inheritParams scales::gradient_n_pal
119#' @param colours,colors Vector of colours to use for n-colour gradient.
120#' @rdname scale_gradient
121#' @export
122scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
123                                   guide = "colourbar", aesthetics = "colour", colors) {
124  colours <- if (missing(colours)) colors else colours
125
126  continuous_scale(aesthetics, "gradientn",
127    gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...)
128}
129#' @rdname scale_gradient
130#' @export
131scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
132                                 guide = "colourbar", aesthetics = "fill", colors) {
133  colours <- if (missing(colours)) colors else colours
134
135  continuous_scale(aesthetics, "gradientn",
136    gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...)
137}
138