Skip to content

Commit 40ccf17

Browse files
clauswilkeclauswilke
committed
remove hardcoded aesthetics setting for scales; adjust guides so they
can make full use of multiple aesthetics for one scale.
1 parent f76a43f commit 40ccf17

26 files changed

+222
-161
lines changed

‎R/guide-colorbar.r

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ guide_colourbar <- function(
191191
}
192192

193193
#' @export
194-
guide_train.colorbar <- function(guide, scale) {
194+
guide_train.colorbar <- function(guide, scale, aesthetic = NULL) {
195195

196196
# do nothing if scale are inappropriate
197197
if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) {
@@ -210,7 +210,7 @@ guide_train.colorbar <- function(guide, scale) {
210210
if (length(breaks) == 0 || all(is.na(breaks)))
211211
return()
212212

213-
ticks <- as.data.frame(setNames(list(scale$map(breaks)), scale$aesthetics[1]))
213+
ticks <- as.data.frame(setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1]))
214214
ticks$.value <- breaks
215215
ticks$.label <- scale$get_labels(breaks)
216216

‎R/guide-legend.r

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -215,14 +215,14 @@ guide_legend <- function(# title
215215
}
216216

217217
#' @export
218-
guide_train.legend <- function(guide, scale) {
218+
guide_train.legend <- function(guide, scale, aesthetic = NULL) {
219219
breaks <- scale$get_breaks()
220220
if (length(breaks) == 0 || all(is.na(breaks))) {
221221
return()
222222
}
223223

224224
key <- as.data.frame(
225-
setNames(list(scale$map(breaks)), scale$aesthetics[1]),
225+
setNames(list(scale$map(breaks)), aesthetic %||% scale$aesthetics[1]),
226226
stringsAsFactors = FALSE
227227
)
228228
key$.label <- scale$get_labels(breaks)

‎R/guides-.r

Lines changed: 25 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -162,37 +162,38 @@ guides_train <- function(scales, theme, guides, labels) {
162162

163163
gdefs <- list()
164164
for (scale in scales$scales) {
165+
for (output in scale$aesthetics) {
165166

166-
# guides(XXX) is stored in guides[[XXX]],
167-
# which is prior to scale_ZZZ(guide=XXX)
168-
# guide is determined in order of:
169-
# + guides(XXX) > + scale_ZZZ(guide=XXX) > default(i.e., legend)
170-
output <- scale$aesthetics[1]
171-
guide <- guides[[output]] %||% scale$guide
167+
# guides(XXX) is stored in guides[[XXX]],
168+
# which is prior to scale_ZZZ(guide=XXX)
169+
# guide is determined in order of:
170+
# + guides(XXX) > + scale_ZZZ(guide=XXX) > default(i.e., legend)
171+
guide <- guides[[output]] %||% scale$guide
172172

173-
# this should be changed to testing guide == "none"
174-
# scale$legend is backward compatibility
175-
# if guides(XXX=FALSE), then scale_ZZZ(guides=XXX) is discarded.
176-
if (guide == "none" || (is.logical(guide) && !guide)) next
173+
# this should be changed to testing guide == "none"
174+
# scale$legend is backward compatibility
175+
# if guides(XXX=FALSE), then scale_ZZZ(guides=XXX) is discarded.
176+
if (guide == "none" || (is.logical(guide) && !guide)) next
177177

178-
# check the validity of guide.
179-
# if guide is character, then find the guide object
180-
guide <- validate_guide(guide)
178+
# check the validity of guide.
179+
# if guide is character, then find the guide object
180+
guide <- validate_guide(guide)
181181

182-
# check the consistency of the guide and scale.
183-
if (guide$available_aes != "any" && !scale$aesthetics %in% guide$available_aes)
184-
stop("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.")
182+
# check the consistency of the guide and scale.
183+
if (guide$available_aes != "any" && !scale$aesthetics %in% guide$available_aes)
184+
stop("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.")
185185

186-
guide$title <- scale$make_title(guide$title %|W|% scale$name %|W|% labels[[output]])
186+
guide$title <- scale$make_title(guide$title %|W|% scale$name %|W|% labels[[output]])
187187

188-
# direction of this grob
189-
guide$direction <- guide$direction %||% theme$legend.direction
188+
# direction of this grob
189+
guide$direction <- guide$direction %||% theme$legend.direction
190190

191-
# each guide object trains scale within the object,
192-
# so Guides (i.e., the container of guides) need not to know about them
193-
guide <- guide_train(guide, scale)
191+
# each guide object trains scale within the object,
192+
# so Guides (i.e., the container of guides) need not to know about them
193+
guide <- guide_train(guide, scale, output)
194194

195-
if (!is.null(guide)) gdefs[[length(gdefs) + 1]] <- guide
195+
if (!is.null(guide)) gdefs[[length(gdefs) + 1]] <- guide
196+
}
196197
}
197198
gdefs
198199
}
@@ -309,7 +310,7 @@ NULL
309310

310311
#' @export
311312
#' @rdname guide-exts
312-
guide_train <- function(guide, scale) UseMethod("guide_train")
313+
guide_train <- function(guide, scale, aesthetic = NULL) UseMethod("guide_train")
313314

314315
#' @export
315316
#' @rdname guide-exts

‎R/scale-alpha.r

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#' @param ... Other arguments passed on to [continuous_scale()]
99
#' or [discrete_scale()] as appropriate, to control name, limits,
1010
#' breaks, labels and so forth.
11+
#' @param aesthetics Character string or vector of character strings listing the
12+
#' name(s) of the aesthetic(s) that this scale works with.
1113
#' @param range Output range of alpha values. Must lie between 0 and 1.
1214
#' @family colour scales
1315
#' @export
@@ -18,8 +20,8 @@
1820
#' p
1921
#' p + scale_alpha("cylinders")
2022
#' p + scale_alpha(range = c(0.4, 0.8))
21-
scale_alpha <- function(..., range = c(0.1, 1)) {
22-
continuous_scale("alpha", "alpha_c", rescale_pal(range), ...)
23+
scale_alpha <- function(..., range = c(0.1, 1), aesthetics = "alpha") {
24+
continuous_scale(aesthetics, "alpha_c", rescale_pal(range), ...)
2325
}
2426

2527
#' @rdname scale_alpha
@@ -35,9 +37,9 @@ scale_alpha_discrete <- function(...) {
3537

3638
#' @rdname scale_alpha
3739
#' @export
38-
scale_alpha_ordinal <- function(..., range = c(0.1, 1)) {
40+
scale_alpha_ordinal <- function(..., range = c(0.1, 1), aesthetics = "alpha") {
3941
discrete_scale(
40-
"alpha",
42+
aesthetics,
4143
"alpha_d",
4244
function(n) seq(range[1], range[2], length.out = n),
4345
...
@@ -47,13 +49,13 @@ scale_alpha_ordinal <- function(..., range = c(0.1, 1)) {
4749
#' @rdname scale_alpha
4850
#' @export
4951
#' @usage NULL
50-
scale_alpha_datetime <- function(..., range = c(0.1, 1)) {
51-
datetime_scale("alpha", "time", palette = rescale_pal(range), ...)
52+
scale_alpha_datetime <- function(..., range = c(0.1, 1), aesthetics = "alpha") {
53+
datetime_scale(aesthetics, "time", palette = rescale_pal(range), ...)
5254
}
5355

5456
#' @rdname scale_alpha
5557
#' @export
5658
#' @usage NULL
57-
scale_alpha_date <- function(..., range = c(0.1, 1)){
58-
datetime_scale("alpha", "date", palette = rescale_pal(range), ...)
59+
scale_alpha_date <- function(..., range = c(0.1, 1), aesthetics = "alpha"){
60+
datetime_scale(aesthetics, "date", palette = rescale_pal(range), ...)
5961
}

‎R/scale-brewer.r

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -65,37 +65,37 @@
6565
#' v
6666
#' v + scale_fill_distiller()
6767
#' v + scale_fill_distiller(palette = "Spectral")
68-
scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1) {
69-
discrete_scale("colour", "brewer", brewer_pal(type, palette, direction), ...)
68+
scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") {
69+
discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...)
7070
}
7171

7272
#' @export
7373
#' @rdname scale_brewer
74-
scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1) {
75-
discrete_scale("fill", "brewer", brewer_pal(type, palette, direction), ...)
74+
scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") {
75+
discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...)
7676
}
7777

7878
#' @export
7979
#' @rdname scale_brewer
80-
scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar") {
80+
scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
8181
# warn about using a qualitative brewer palette to generate the gradient
8282
type <- match.arg(type, c("seq", "div", "qual"))
8383
if (type == "qual") {
8484
warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE)
8585
}
86-
continuous_scale("colour", "distiller",
86+
continuous_scale(aesthetics, "distiller",
8787
gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, guide = guide, ...)
8888
# NB: 6 colours per palette gives nice gradients; more results in more saturated colours which do not look as good
8989
}
9090

9191
#' @export
9292
#' @rdname scale_brewer
93-
scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar") {
93+
scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
9494
type <- match.arg(type, c("seq", "div", "qual"))
9595
if (type == "qual") {
9696
warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE)
9797
}
98-
continuous_scale("fill", "distiller",
98+
continuous_scale(aesthetics, "distiller",
9999
gradient_n_pal(brewer_pal(type, palette, direction)(6), values, space), na.value = na.value, guide = guide, ...)
100100
}
101101

‎R/scale-gradient.r

Lines changed: 20 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -54,15 +54,17 @@
5454
#' scale_colour_gradient(low = "white", high = "black")
5555
#' # Avoid red-green colour contrasts because ~10% of men have difficulty
5656
#' # seeing them
57-
scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar") {
58-
continuous_scale("colour", "gradient", seq_gradient_pal(low, high, space),
57+
scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
58+
na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
59+
continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space),
5960
na.value = na.value, guide = guide, ...)
6061
}
6162

6263
#' @rdname scale_gradient
6364
#' @export
64-
scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar") {
65-
continuous_scale("fill", "gradient", seq_gradient_pal(low, high, space),
65+
scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
66+
na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
67+
continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space),
6668
na.value = na.value, guide = guide, ...)
6769
}
6870

@@ -71,16 +73,20 @@ scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space =
7173
#' Defaults to 0.
7274
#' @rdname scale_gradient
7375
#' @export
74-
scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar") {
75-
continuous_scale("colour", "gradient2",
76+
scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
77+
midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
78+
aesthetics = "colour") {
79+
continuous_scale(aesthetics, "gradient2",
7680
div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ...,
7781
rescaler = mid_rescaler(mid = midpoint))
7882
}
7983

8084
#' @rdname scale_gradient
8185
#' @export
82-
scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar") {
83-
continuous_scale("fill", "gradient2",
86+
scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
87+
midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
88+
aesthetics = "fill") {
89+
continuous_scale(aesthetics, "gradient2",
8490
div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ...,
8591
rescaler = mid_rescaler(mid = midpoint))
8692
}
@@ -95,17 +101,19 @@ mid_rescaler <- function(mid) {
95101
#' @param colours,colors Vector of colours to use for n-colour gradient.
96102
#' @rdname scale_gradient
97103
#' @export
98-
scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", colors) {
104+
scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
105+
guide = "colourbar", aesthetics = "colour", colors) {
99106
colours <- if (missing(colours)) colors else colours
100107

101-
continuous_scale("colour", "gradientn",
108+
continuous_scale(aesthetics, "gradientn",
102109
gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...)
103110
}
104111
#' @rdname scale_gradient
105112
#' @export
106-
scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", colors) {
113+
scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
114+
guide = "colourbar", aesthetics = "fill", colors) {
107115
colours <- if (missing(colours)) colors else colours
108116

109-
continuous_scale("fill", "gradientn",
117+
continuous_scale(aesthetics, "gradientn",
110118
gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...)
111119
}

‎R/scale-grey.r

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,14 +25,14 @@
2525
#' ggplot(mtcars, aes(mpg, wt)) +
2626
#' geom_point(aes(colour = miss)) +
2727
#' scale_colour_grey(na.value = "green")
28-
scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") {
29-
discrete_scale("colour", "grey", grey_pal(start, end),
28+
scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "colour") {
29+
discrete_scale(aesthetics, "grey", grey_pal(start, end),
3030
na.value = na.value, ...)
3131
}
3232

3333
#' @rdname scale_grey
3434
#' @export
35-
scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red") {
36-
discrete_scale("fill", "grey", grey_pal(start, end),
35+
scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "fill") {
36+
discrete_scale(aesthetics, "grey", grey_pal(start, end),
3737
na.value = na.value, ...)
3838
}

‎R/scale-hue.r

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,9 @@
55
#' colour-blind safe palettes.
66
#'
77
#' @param na.value Colour to use for missing values
8-
#' @inheritDotParams discrete_scale
8+
#' @inheritDotParams discrete_scale -aesthetics
9+
#' @param aesthetics Character string or vector of character strings listing the
10+
#' name(s) of the aesthetic(s) that this scale works with.
911
#' @inheritParams scales::hue_pal
1012
#' @rdname scale_hue
1113
#' @export
@@ -46,14 +48,16 @@
4648
#' geom_point(aes(colour = miss)) +
4749
#' scale_colour_hue(na.value = "black")
4850
#' }
49-
scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") {
50-
discrete_scale("colour", "hue", hue_pal(h, c, l, h.start, direction),
51+
scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
52+
direction = 1, na.value = "grey50", aesthetics = "colour") {
53+
discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction),
5154
na.value = na.value, ...)
5255
}
5356

5457
#' @rdname scale_hue
5558
#' @export
56-
scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50") {
57-
discrete_scale("fill", "hue", hue_pal(h, c, l, h.start, direction),
59+
scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
60+
direction = 1, na.value = "grey50", aesthetics = "fill") {
61+
discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction),
5862
na.value = na.value, ...)
5963
}

‎R/scale-identity.r

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
#'
88
#' @param ... Other arguments passed on to [discrete_scale()] or
99
#' [continuous_scale()]
10+
#' @param aesthetics The names of the aesthetics that this scale works with
1011
#' @param guide Guide to use for this scale. Defaults to `"none"`.
1112
#' @examples
1213
#' ggplot(luv_colours, aes(u, v)) +
@@ -48,53 +49,53 @@ NULL
4849

4950
#' @rdname scale_identity
5051
#' @export
51-
scale_colour_identity <- function(..., guide = "none") {
52-
sc <- discrete_scale("colour", "identity", identity_pal(), ..., guide = guide,
52+
scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") {
53+
sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
5354
super = ScaleDiscreteIdentity)
5455

5556
sc
5657
}
5758

5859
#' @rdname scale_identity
5960
#' @export
60-
scale_fill_identity <- function(..., guide = "none") {
61-
sc <- discrete_scale("fill", "identity", identity_pal(), ..., guide = guide,
61+
scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") {
62+
sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
6263
super = ScaleDiscreteIdentity)
6364

6465
sc
6566
}
6667

6768
#' @rdname scale_identity
6869
#' @export
69-
scale_shape_identity <- function(..., guide = "none") {
70-
sc <- continuous_scale("shape", "identity", identity_pal(), ..., guide = guide,
70+
scale_shape_identity <- function(..., guide = "none", aesthetics = "shape") {
71+
sc <- continuous_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
7172
super = ScaleDiscreteIdentity)
7273

7374
sc
7475
}
7576

7677
#' @rdname scale_identity
7778
#' @export
78-
scale_linetype_identity <- function(..., guide = "none") {
79-
sc <- discrete_scale("linetype", "identity", identity_pal(), ..., guide = guide,
79+
scale_linetype_identity <- function(..., guide = "none", aesthetics = "linetype") {
80+
sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
8081
super = ScaleDiscreteIdentity)
8182

8283
sc
8384
}
8485

8586
#' @rdname scale_identity
8687
#' @export
87-
scale_alpha_identity <- function(..., guide = "none") {
88-
sc <- continuous_scale("alpha", "identity", identity_pal(), ..., guide = guide,
88+
scale_alpha_identity <- function(..., guide = "none", aesthetics = "alpha") {
89+
sc <- continuous_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
8990
super = ScaleContinuousIdentity)
9091

9192
sc
9293
}
9394

9495
#' @rdname scale_identity
9596
#' @export
96-
scale_size_identity <- function(..., guide = "none") {
97-
sc <- continuous_scale("size", "identity", identity_pal(), ..., guide = guide,
97+
scale_size_identity <- function(..., guide = "none", aesthetics = "size") {
98+
sc <- continuous_scale(aesthetics, "identity", identity_pal(), ..., guide = guide,
9899
super = ScaleContinuousIdentity)
99100

100101
sc

0 commit comments

Comments
 (0)