From 0f9fb64505bdb404081bdbfa09b34aa7213f699f Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 21:57:40 +0100
Subject: [PATCH 1/3] Scale name first (#5583)
* name is first scale argument
* hotfix for midpoint rescale
* add news bullet
* document
---
NEWS.md | 4 ++
R/scale-alpha.R | 29 +++++---
R/scale-brewer.R | 55 ++++++++++----
R/scale-discrete-.R | 22 ++++--
R/scale-gradient.R | 54 +++++++++-----
R/scale-grey.R | 20 ++++--
R/scale-hue.R | 44 ++++++++----
R/scale-identity.R | 104 +++++++++++++++------------
R/scale-linetype.R | 19 +++--
R/scale-linewidth.R | 18 +++--
R/scale-manual.R | 10 ++-
R/scale-shape.R | 8 +--
R/scale-size.R | 30 ++++----
R/scale-steps.R | 81 ++++++++++++++-------
R/scale-viridis.R | 58 ++++++++-------
R/zxx.R | 21 +++---
man/ggplot2-package.Rd | 1 +
man/scale_alpha.Rd | 13 ++--
man/scale_brewer.Rd | 11 +++
man/scale_discrete.Rd | 25 +++++--
man/scale_gradient.Rd | 15 ++--
man/scale_grey.Rd | 11 +--
man/scale_hue.Rd | 11 +--
man/scale_identity.Rd | 28 +++++---
man/scale_linetype.Rd | 15 ++--
man/scale_shape.Rd | 13 ++--
man/scale_size.Rd | 4 +-
man/scale_steps.Rd | 15 ++--
man/scale_viridis.Rd | 11 +++
tests/testthat/test-scale-gradient.R | 4 +-
30 files changed, 497 insertions(+), 257 deletions(-)
diff --git a/NEWS.md b/NEWS.md
index dd9ef05b30..5d47b01f86 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,7 +1,11 @@
# ggplot2 (development version)
+* The `name` argument in most scales is now explicitly the first argument
+ (#5535)
+
* New `display` argument in `guide_colourbar()` supplants the `raster` argument.
In R 4.1.0 and above, `display = "gradient"` will draw a gradient.
+
* When using `geom_dotplot(binaxis = "x")` with a discrete y-variable, dots are
now stacked from the y-position rather than from 0 (@teunbrand, #5462)
diff --git a/R/scale-alpha.R b/R/scale-alpha.R
index 9271bd0b5b..db0af9f3c6 100644
--- a/R/scale-alpha.R
+++ b/R/scale-alpha.R
@@ -9,6 +9,7 @@
#' or [discrete_scale()] as appropriate, to control name, limits,
#' breaks, labels and so forth.
#' @param range Output range of alpha values. Must lie between 0 and 1.
+#' @inheritParams continuous_scale
#' @family colour scales
#' @family alpha scales
#' @seealso
@@ -23,8 +24,8 @@
#' p
#' p + scale_alpha("cylinders")
#' p + scale_alpha(range = c(0.4, 0.8))
-scale_alpha <- function(..., range = c(0.1, 1)) {
- continuous_scale("alpha", palette = pal_rescale(range), ...)
+scale_alpha <- function(name = waiver(), ..., range = c(0.1, 1)) {
+ continuous_scale("alpha", name = name, palette = pal_rescale(range), ...)
}
#' @rdname scale_alpha
@@ -33,8 +34,8 @@ scale_alpha_continuous <- scale_alpha
#' @rdname scale_alpha
#' @export
-scale_alpha_binned <- function(..., range = c(0.1, 1)) {
- binned_scale("alpha", palette = pal_rescale(range), ...)
+scale_alpha_binned <- function(name = waiver(), ..., range = c(0.1, 1)) {
+ binned_scale("alpha", name = name, palette = pal_rescale(range), ...)
}
#' @rdname scale_alpha
@@ -48,9 +49,9 @@ scale_alpha_discrete <- function(...) {
#' @rdname scale_alpha
#' @export
-scale_alpha_ordinal <- function(..., range = c(0.1, 1)) {
+scale_alpha_ordinal <- function(name = waiver(), ..., range = c(0.1, 1)) {
discrete_scale(
- "alpha",
+ "alpha", name = name,
palette = function(n) seq(range[1], range[2], length.out = n),
...
)
@@ -59,13 +60,21 @@ scale_alpha_ordinal <- function(..., range = c(0.1, 1)) {
#' @rdname scale_alpha
#' @export
#' @usage NULL
-scale_alpha_datetime <- function(..., range = c(0.1, 1)) {
- datetime_scale("alpha", "time", palette = pal_rescale(range), ...)
+scale_alpha_datetime <- function(name = waiver(), ..., range = c(0.1, 1)) {
+ datetime_scale(
+ aesthetics = "alpha", transform = "time", name = name,
+ palette = pal_rescale(range),
+ ...
+ )
}
#' @rdname scale_alpha
#' @export
#' @usage NULL
-scale_alpha_date <- function(..., range = c(0.1, 1)){
- datetime_scale("alpha", "date", palette = pal_rescale(range), ...)
+scale_alpha_date <- function(name = waiver(), ..., range = c(0.1, 1)){
+ datetime_scale(
+ aesthetics = "alpha", transform = "date", name = name,
+ palette = pal_rescale(range),
+ ...
+ )
}
diff --git a/R/scale-brewer.R b/R/scale-brewer.R
index f01daff81c..6ce2d322bf 100644
--- a/R/scale-brewer.R
+++ b/R/scale-brewer.R
@@ -83,19 +83,32 @@
#' # or use blender variants to discretise continuous data
#' v + scale_fill_fermenter()
#'
-scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") {
- discrete_scale(aesthetics, palette = pal_brewer(type, palette, direction), ...)
+scale_colour_brewer <- function(name = waiver(), ..., type = "seq", palette = 1,
+ direction = 1, aesthetics = "colour") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_brewer(type, palette, direction),
+ ...
+ )
}
#' @export
#' @rdname scale_brewer
-scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") {
- discrete_scale(aesthetics, palette = pal_brewer(type, palette, direction), ...)
+scale_fill_brewer <- function(name = waiver(), ..., type = "seq", palette = 1,
+ direction = 1, aesthetics = "fill") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_brewer(type, palette, direction),
+ ...
+ )
}
#' @export
#' @rdname scale_brewer
-scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
+scale_colour_distiller <- function(name = waiver(), ..., type = "seq",
+ palette = 1, direction = -1, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "colourbar", aesthetics = "colour") {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
@@ -105,7 +118,7 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -
))
}
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space),
na.value = na.value, guide = guide, ...
)
@@ -115,7 +128,10 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -
#' @export
#' @rdname scale_brewer
-scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
+scale_fill_distiller <- function(name = waiver(), ..., type = "seq",
+ palette = 1, direction = -1, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "colourbar", aesthetics = "fill") {
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
@@ -124,7 +140,7 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1,
))
}
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space),
na.value = na.value, guide = guide, ...
)
@@ -132,7 +148,10 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1,
#' @export
#' @rdname scale_brewer
-scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") {
+scale_colour_fermenter <- function(name = waiver(), ..., type = "seq",
+ palette = 1, direction = -1,
+ na.value = "grey50", guide = "coloursteps",
+ aesthetics = "colour") {
# warn about using a qualitative brewer palette to generate the gradient
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
@@ -141,12 +160,19 @@ scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
- binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_binned(pal_brewer(type, palette, direction)),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
#' @export
#' @rdname scale_brewer
-scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") {
+scale_fill_fermenter <- function(name = waiver(), ..., type = "seq", palette = 1,
+ direction = -1, na.value = "grey50",
+ guide = "coloursteps", aesthetics = "fill") {
type <- arg_match0(type, c("seq", "div", "qual"))
if (type == "qual") {
cli::cli_warn(c(
@@ -154,5 +180,10 @@ scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1,
"i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
))
}
- binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_binned(pal_brewer(type, palette, direction)),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R
index 339df10122..b5f2f53df3 100644
--- a/R/scale-discrete-.R
+++ b/R/scale-discrete-.R
@@ -61,18 +61,28 @@
#' geom_point() +
#' scale_x_discrete(labels = abbreviate)
#' }
-scale_x_discrete <- function(..., expand = waiver(), guide = waiver(), position = "bottom") {
- sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), palette = identity, ...,
- expand = expand, guide = guide, position = position, super = ScaleDiscretePosition)
+scale_x_discrete <- function(name = waiver(), ..., expand = waiver(),
+ guide = waiver(), position = "bottom") {
+ sc <- discrete_scale(
+ aesthetics = c("x", "xmin", "xmax", "xend"), name = name,
+ palette = identity, ...,
+ expand = expand, guide = guide, position = position,
+ super = ScaleDiscretePosition
+ )
sc$range_c <- ContinuousRange$new()
sc
}
#' @rdname scale_discrete
#' @export
-scale_y_discrete <- function(..., expand = waiver(), guide = waiver(), position = "left") {
- sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), palette = identity, ...,
- expand = expand, guide = guide, position = position, super = ScaleDiscretePosition)
+scale_y_discrete <- function(name = waiver(), ..., expand = waiver(),
+ guide = waiver(), position = "left") {
+ sc <- discrete_scale(
+ aesthetics = c("y", "ymin", "ymax", "yend"), name = name,
+ palette = identity, ...,
+ expand = expand, guide = guide, position = position,
+ super = ScaleDiscretePosition
+ )
sc$range_c <- ContinuousRange$new()
sc
diff --git a/R/scale-gradient.R b/R/scale-gradient.R
index 4739fd342f..a96b9eff7c 100644
--- a/R/scale-gradient.R
+++ b/R/scale-gradient.R
@@ -75,18 +75,30 @@
#' geom_point(aes(colour = z1)) +
#' scale_colour_gradient(low = "yellow", high = "red", na.value = NA)
#'
-scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
- na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
- continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space),
- na.value = na.value, guide = guide, ...)
+scale_colour_gradient <- function(name = waiver(), ..., low = "#132B43",
+ high = "#56B1F7", space = "Lab",
+ na.value = "grey50",
+ guide = "colourbar", aesthetics = "colour") {
+ continuous_scale(
+ aesthetics, name = name,
+ palette = pal_seq_gradient(low, high, space),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
#' @rdname scale_gradient
#' @export
-scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
- na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
- continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space),
- na.value = na.value, guide = guide, ...)
+scale_fill_gradient <- function(name = waiver(), ..., low = "#132B43",
+ high = "#56B1F7", space = "Lab",
+ na.value = "grey50", guide = "colourbar",
+ aesthetics = "fill") {
+ continuous_scale(
+ aesthetics, name = name,
+ palette = pal_seq_gradient(low, high, space),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
#' @inheritParams scales::pal_div_gradient
@@ -95,12 +107,13 @@ scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space =
#' Defaults to 0.
#' @rdname scale_gradient
#' @export
-scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
+scale_colour_gradient2 <- function(name = waiver(), ..., low = muted("red"),
+ mid = "white", high = muted("blue"),
midpoint = 0, space = "Lab", na.value = "grey50",
transform = "identity", guide = "colourbar",
aesthetics = "colour") {
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = div_gradient_pal(low, mid, high, space),
na.value = na.value, transform = transform, guide = guide, ...,
rescaler = mid_rescaler(mid = midpoint, transform = transform)
@@ -109,12 +122,13 @@ scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high
#' @rdname scale_gradient
#' @export
-scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
+scale_fill_gradient2 <- function(name = waiver(), ..., low = muted("red"),
+ mid = "white", high = muted("blue"),
midpoint = 0, space = "Lab", na.value = "grey50",
transform = "identity", guide = "colourbar",
aesthetics = "fill") {
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = div_gradient_pal(low, mid, high, space),
na.value = na.value, transform = transform, guide = guide, ...,
rescaler = mid_rescaler(mid = midpoint, transform = transform)
@@ -138,24 +152,28 @@ mid_rescaler <- function(mid, transform = "identity",
#' @param colours,colors Vector of colours to use for n-colour gradient.
#' @rdname scale_gradient
#' @export
-scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
- guide = "colourbar", aesthetics = "colour", colors) {
+scale_colour_gradientn <- function(name = waiver(), ..., colours, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "colourbar", aesthetics = "colour",
+ colors) {
colours <- if (missing(colours)) colors else colours
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(colours, values, space),
na.value = na.value, guide = guide, ...
)
}
#' @rdname scale_gradient
#' @export
-scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
- guide = "colourbar", aesthetics = "fill", colors) {
+scale_fill_gradientn <- function(name = waiver(), ..., colours, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "colourbar", aesthetics = "fill",
+ colors) {
colours <- if (missing(colours)) colors else colours
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(colours, values, space),
na.value = na.value, guide = guide, ...
)
diff --git a/R/scale-grey.R b/R/scale-grey.R
index d32437606f..1ec6a1f8e9 100644
--- a/R/scale-grey.R
+++ b/R/scale-grey.R
@@ -27,14 +27,22 @@
#' ggplot(mtcars, aes(mpg, wt)) +
#' geom_point(aes(colour = miss)) +
#' scale_colour_grey(na.value = "green")
-scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "colour") {
- discrete_scale(aesthetics, palette = pal_grey(start, end),
- na.value = na.value, ...)
+scale_colour_grey <- function(name = waiver(), ..., start = 0.2, end = 0.8,
+ na.value = "red", aesthetics = "colour") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_grey(start, end),
+ na.value = na.value, ...
+ )
}
#' @rdname scale_grey
#' @export
-scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "fill") {
- discrete_scale(aesthetics, palette = pal_grey(start, end),
- na.value = na.value, ...)
+scale_fill_grey <- function(name = waiver(), ..., start = 0.2, end = 0.8,
+ na.value = "red", aesthetics = "fill") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_grey(start, end),
+ na.value = na.value, ...
+ )
}
diff --git a/R/scale-hue.R b/R/scale-hue.R
index 64ca050e53..cb0e8fbd8c 100644
--- a/R/scale-hue.R
+++ b/R/scale-hue.R
@@ -10,6 +10,7 @@
#' example, to apply colour settings to the `colour` and `fill` aesthetics at the
#' same time, via `aesthetics = c("colour", "fill")`.
#' @inheritParams scales::pal_hue
+#' @inheritParams discrete_scale
#' @rdname scale_hue
#' @export
#' @family colour scales
@@ -53,18 +54,26 @@
#' 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, palette = pal_hue(h, c, l, h.start, direction),
- na.value = na.value, ...)
+scale_colour_hue <- function(name = waiver(), ..., h = c(0, 360) + 15, c = 100,
+ l = 65, h.start = 0, direction = 1,
+ na.value = "grey50", aesthetics = "colour") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_hue(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, palette = pal_hue(h, c, l, h.start, direction),
- na.value = na.value, ...)
+scale_fill_hue <- function(name = waiver(), ..., h = c(0, 360) + 15, c = 100,
+ l = 65, h.start = 0, direction = 1,
+ na.value = "grey50", aesthetics = "fill") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_hue(h, c, l, h.start, direction),
+ na.value = na.value, ...
+ )
}
@@ -165,18 +174,25 @@ scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill"))
}
}
-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") {
+scale_colour_qualitative <- function(name = waiver(), ..., type = NULL,
+ h = c(0, 360) + 15, c = 100, l = 65,
+ h.start = 0, direction = 1,
+ na.value = "grey50",
+ aesthetics = "colour") {
discrete_scale(
- aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction),
+ aesthetics, name = name,
+ palette = pal_qualitative(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") {
+scale_fill_qualitative <- function(name = waiver(), ..., type = NULL,
+ h = c(0, 360) + 15, c = 100, l = 65,
+ h.start = 0, direction = 1,
+ na.value = "grey50", aesthetics = "fill") {
discrete_scale(
- aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction),
+ aesthetics, name = name,
+ palette = pal_qualitative(type, h, c, l, h.start, direction),
na.value = na.value, ...
)
}
diff --git a/R/scale-identity.R b/R/scale-identity.R
index b070d04c4b..dd07393635 100644
--- a/R/scale-identity.R
+++ b/R/scale-identity.R
@@ -21,6 +21,7 @@
#' example, to apply colour settings to the `colour` and `fill` aesthetics at the
#' same time, via `aesthetics = c("colour", "fill")`.
#' @param guide Guide to use for this scale. Defaults to `"none"`.
+#' @inheritParams continuous_scale
#' @family colour scales
#' @examples
#' ggplot(luv_colours, aes(u, v)) +
@@ -62,91 +63,104 @@ NULL
#' @rdname scale_identity
#' @export
-scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") {
- sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide,
- super = ScaleDiscreteIdentity)
-
- sc
+scale_colour_identity <- function(name = waiver(), ..., guide = "none",
+ aesthetics = "colour") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleDiscreteIdentity
+ )
}
#' @rdname scale_identity
#' @export
-scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") {
- sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide,
- super = ScaleDiscreteIdentity)
-
- sc
+scale_fill_identity <- function(name = waiver(), ..., guide = "none",
+ aesthetics = "fill") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleDiscreteIdentity
+ )
}
#' @rdname scale_identity
#' @seealso
#' Other shape scales: [scale_shape()], [scale_shape_manual()].
#' @export
-scale_shape_identity <- function(..., guide = "none") {
- sc <- continuous_scale("shape", palette = pal_identity(), ..., guide = guide,
- super = ScaleContinuousIdentity)
-
- sc
+scale_shape_identity <- function(name = waiver(), ..., guide = "none") {
+ continuous_scale(
+ "shape", name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleContinuousIdentity
+ )
}
#' @rdname scale_identity
#' @seealso
#' Other linetype scales: [scale_linetype()], [scale_linetype_manual()].
#' @export
-scale_linetype_identity <- function(..., guide = "none") {
- sc <- discrete_scale("linetype", palette = pal_identity(), ..., guide = guide,
- super = ScaleDiscreteIdentity)
-
- sc
+scale_linetype_identity <- function(name = waiver(), ..., guide = "none") {
+ discrete_scale(
+ "linetype", name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleDiscreteIdentity
+ )
}
#' @rdname scale_identity
#' @seealso
#' Other alpha scales: [scale_alpha()], [scale_alpha_manual()].
#' @export
-scale_linewidth_identity <- function(..., guide = "none") {
- sc <- continuous_scale("linewidth", palette = pal_identity(), ...,
- guide = guide, super = ScaleContinuousIdentity)
-
- sc
+scale_linewidth_identity <- function(name = waiver(), ..., guide = "none") {
+ continuous_scale(
+ "linewidth", name = name,
+ palette = pal_identity(), ...,
+ guide = guide, super = ScaleContinuousIdentity
+ )
}
#' @rdname scale_identity
#' @export
-scale_alpha_identity <- function(..., guide = "none") {
- sc <- continuous_scale("alpha", palette = pal_identity(), ..., guide = guide,
- super = ScaleContinuousIdentity)
-
- sc
+scale_alpha_identity <- function(name = waiver(), ..., guide = "none") {
+ continuous_scale(
+ "alpha", name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleContinuousIdentity
+ )
}
#' @rdname scale_identity
#' @seealso
#' Other size scales: [scale_size()], [scale_size_manual()].
#' @export
-scale_size_identity <- function(..., guide = "none") {
- sc <- continuous_scale("size", palette = pal_identity(), ..., guide = guide,
- super = ScaleContinuousIdentity)
-
- sc
+scale_size_identity <- function(name = waiver(), ..., guide = "none") {
+ continuous_scale(
+ "size", name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleContinuousIdentity
+ )
}
#' @rdname scale_identity
#' @export
-scale_discrete_identity <- function(aesthetics, ..., guide = "none") {
- sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide,
- super = ScaleDiscreteIdentity)
-
- sc
+scale_discrete_identity <- function(aesthetics, name = waiver(), ...,
+ guide = "none") {
+ discrete_scale(
+ aesthetics, name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleDiscreteIdentity
+ )
}
#' @rdname scale_identity
#' @export
-scale_continuous_identity <- function(aesthetics, ..., guide = "none") {
- sc <- continuous_scale(aesthetics, palette = pal_identity(), ..., guide = guide,
- super = ScaleContinuousIdentity)
-
- sc
+scale_continuous_identity <- function(aesthetics, name = waiver(), ...,
+ guide = "none") {
+ continuous_scale(
+ aesthetics, name = name,
+ palette = pal_identity(), ..., guide = guide,
+ super = ScaleContinuousIdentity
+ )
}
#' @rdname ggplot2-ggproto
diff --git a/R/scale-linetype.R b/R/scale-linetype.R
index bf382c985a..d590613ba1 100644
--- a/R/scale-linetype.R
+++ b/R/scale-linetype.R
@@ -33,15 +33,24 @@
#' scale_linetype_identity() +
#' facet_grid(linetype ~ .) +
#' theme_void(20)
-scale_linetype <- function(..., na.value = "blank") {
- discrete_scale("linetype", palette = pal_linetype(),
- na.value = na.value, ...)
+scale_linetype <- function(name = waiver(), ..., na.value = "blank") {
+ discrete_scale(
+ "linetype", name = name,
+ palette = pal_linetype(),
+ na.value = na.value,
+ ...
+ )
}
#' @rdname scale_linetype
#' @export
-scale_linetype_binned <- function(..., na.value = "blank") {
- binned_scale("linetype", palette = pal_binned(pal_linetype()), ...)
+scale_linetype_binned <- function(name = waiver(), ..., na.value = "blank") {
+ binned_scale(
+ "linetype", name = name,
+ palette = pal_binned(pal_linetype()),
+ na.value = na.value,
+ ...
+ )
}
#' @rdname scale_linetype
diff --git a/R/scale-linewidth.R b/R/scale-linewidth.R
index 993e11f5e1..72e4be76aa 100644
--- a/R/scale-linewidth.R
+++ b/R/scale-linewidth.R
@@ -66,11 +66,11 @@ scale_linewidth_discrete <- function(...) {
#' @rdname scale_linewidth
#' @export
#' @usage NULL
-scale_linewidth_ordinal <- function(..., range = c(2, 6)) {
+scale_linewidth_ordinal <- function(name = waiver(), ..., range = c(2, 6)) {
force(range)
discrete_scale(
- "linewidth",
+ "linewidth", name = name,
palette = function(n) seq(range[1], range[2], length.out = n),
...
)
@@ -79,13 +79,19 @@ scale_linewidth_ordinal <- function(..., range = c(2, 6)) {
#' @rdname scale_linewidth
#' @export
#' @usage NULL
-scale_linewidth_datetime <- function(..., range = c(1, 6)) {
- datetime_scale("linewidth", "time", palette = pal_rescale(range), ...)
+scale_linewidth_datetime <- function(name = waiver(), ..., range = c(1, 6)) {
+ datetime_scale(
+ "linewidth", transform = "time", name = name,
+ palette = pal_rescale(range), ...
+ )
}
#' @rdname scale_linewidth
#' @export
#' @usage NULL
-scale_linewidth_date <- function(..., range = c(1, 6)) {
- datetime_scale("linewidth", "date", palette = pal_rescale(range), ...)
+scale_linewidth_date <- function(name = waiver(), ..., range = c(1, 6)) {
+ datetime_scale(
+ "linewidth", transform = "date", name = name,
+ palette = pal_rescale(range), ...
+ )
}
diff --git a/R/scale-manual.R b/R/scale-manual.R
index 380d64d64f..d57ceec3cd 100644
--- a/R/scale-manual.R
+++ b/R/scale-manual.R
@@ -141,7 +141,8 @@ scale_discrete_manual <- function(aesthetics, ..., values, breaks = waiver()) {
manual_scale(aesthetics, values, breaks, ...)
}
-manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...,
+manual_scale <- function(aesthetic, values = NULL, breaks = waiver(),
+ name = waiver(), ...,
limits = NULL, call = caller_call()) {
call <- call %||% current_call()
# check for missing `values` parameter, in lieu of providing
@@ -183,6 +184,9 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ...,
}
values
}
- discrete_scale(aesthetic, palette = pal, breaks = breaks, limits = limits,
- call = call, ...)
+ discrete_scale(
+ aesthetic, name = name,
+ palette = pal, breaks = breaks, limits = limits,
+ call = call, ...
+ )
}
diff --git a/R/scale-shape.R b/R/scale-shape.R
index 4942ebbdef..089b8d62f7 100644
--- a/R/scale-shape.R
+++ b/R/scale-shape.R
@@ -40,14 +40,14 @@
#' scale_shape_identity() +
#' facet_wrap(~shape) +
#' theme_void()
-scale_shape <- function(..., solid = TRUE) {
- discrete_scale("shape", palette = pal_shape(solid), ...)
+scale_shape <- function(name = waiver(), ..., solid = TRUE) {
+ discrete_scale("shape", name = name, palette = pal_shape(solid), ...)
}
#' @rdname scale_shape
#' @export
-scale_shape_binned <- function(..., solid = TRUE) {
- binned_scale("shape", palette = pal_binned(pal_shape(solid)), ...)
+scale_shape_binned <- function(name = waiver(), ..., solid = TRUE) {
+ binned_scale("shape", name = name, palette = pal_binned(pal_shape(solid)), ...)
}
#' @rdname scale_shape
diff --git a/R/scale-size.R b/R/scale-size.R
index c1928fcf18..829d2c5deb 100644
--- a/R/scale-size.R
+++ b/R/scale-size.R
@@ -99,11 +99,11 @@ scale_size_discrete <- function(...) {
#' @rdname scale_size
#' @export
#' @usage NULL
-scale_size_ordinal <- function(..., range = c(2, 6)) {
+scale_size_ordinal <- function(name = waiver(), ..., range = c(2, 6)) {
force(range)
discrete_scale(
- "size",
+ "size", name = name,
palette = function(n) {
area <- seq(range[1] ^ 2, range[2] ^ 2, length.out = n)
sqrt(area)
@@ -116,30 +116,34 @@ scale_size_ordinal <- function(..., range = c(2, 6)) {
#' @param max_size Size of largest points.
#' @export
#' @rdname scale_size
-scale_size_area <- function(..., max_size = 6) {
- continuous_scale("size",
+scale_size_area <- function(name = waiver(), ..., max_size = 6) {
+ continuous_scale(
+ "size", name = name,
palette = abs_area(max_size),
- rescaler = rescale_max, ...)
+ rescaler = rescale_max, ...
+ )
}
#' @export
#' @rdname scale_size
-scale_size_binned_area <- function(..., max_size = 6) {
- binned_scale("size",
- palette = abs_area(max_size),
- rescaler = rescale_max, ...)
+scale_size_binned_area <- function(name = waiver(), ..., max_size = 6) {
+ binned_scale(
+ "size", name = name,
+ palette = abs_area(max_size),
+ rescaler = rescale_max, ...
+ )
}
#' @rdname scale_size
#' @export
#' @usage NULL
-scale_size_datetime <- function(..., range = c(1, 6)) {
- datetime_scale("size", "time", palette = pal_area(range), ...)
+scale_size_datetime <- function(name = waiver(), ..., range = c(1, 6)) {
+ datetime_scale("size", "time", name = name, palette = pal_area(range), ...)
}
#' @rdname scale_size
#' @export
#' @usage NULL
-scale_size_date <- function(..., range = c(1, 6)) {
- datetime_scale("size", "date", palette = pal_area(range), ...)
+scale_size_date <- function(name = waiver(), ..., range = c(1, 6)) {
+ datetime_scale("size", "date", name = name, palette = pal_area(range), ...)
}
diff --git a/R/scale-steps.R b/R/scale-steps.R
index 1402f0ff75..4b86861f50 100644
--- a/R/scale-steps.R
+++ b/R/scale-steps.R
@@ -44,52 +44,83 @@
#' geom_point(aes(colour = z1)) +
#' scale_colour_stepsn(colours = terrain.colors(10))
#' @rdname scale_steps
-scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
- na.value = "grey50", guide = "coloursteps", aesthetics = "colour") {
- binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space),
- na.value = na.value, guide = guide, ...)
+scale_colour_steps <- function(name = waiver(), ..., low = "#132B43",
+ high = "#56B1F7", space = "Lab",
+ na.value = "grey50", guide = "coloursteps",
+ aesthetics = "colour") {
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_seq_gradient(low, high, space),
+ na.value = na.value, guide = guide, ...
+ )
}
#' @rdname scale_steps
#' @export
-scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
+scale_colour_steps2 <- function(name = waiver(), ..., low = muted("red"),
+ mid = "white", high = muted("blue"),
midpoint = 0, space = "Lab", na.value = "grey50",
transform = "identity", guide = "coloursteps",
aesthetics = "colour") {
- binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space),
- na.value = na.value, transform = transform, guide = guide,
- rescaler = mid_rescaler(mid = midpoint, transform = transform),
- ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = div_gradient_pal(low, mid, high, space),
+ na.value = na.value, transform = transform, guide = guide,
+ rescaler = mid_rescaler(mid = midpoint, transform = transform),
+ ...
+ )
}
#' @rdname scale_steps
#' @export
-scale_colour_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
- guide = "coloursteps", aesthetics = "colour", colors) {
+scale_colour_stepsn <- function(name = waiver(), ..., colours, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "coloursteps", aesthetics = "colour",
+ colors) {
colours <- if (missing(colours)) colors else colours
- binned_scale(aesthetics, palette = pal_gradient_n(colours, values, space),
- na.value = na.value, guide = guide, ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_gradient_n(colours, values, space),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
#' @rdname scale_steps
#' @export
-scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab",
- na.value = "grey50", guide = "coloursteps", aesthetics = "fill") {
- binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space),
- na.value = na.value, guide = guide, ...)
+scale_fill_steps <- function(name = waiver(), ..., low = "#132B43",
+ high = "#56B1F7", space = "Lab",
+ na.value = "grey50", guide = "coloursteps",
+ aesthetics = "fill") {
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_seq_gradient(low, high, space),
+ na.value = na.value, guide = guide,
+ ...
+ )
}
#' @rdname scale_steps
#' @export
-scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
+scale_fill_steps2 <- function(name = waiver(), ..., low = muted("red"),
+ mid = "white", high = muted("blue"),
midpoint = 0, space = "Lab", na.value = "grey50",
transform = "identity", guide = "coloursteps",
aesthetics = "fill") {
- binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space),
- na.value = na.value, transform = transform, guide = guide,
- rescaler = mid_rescaler(mid = midpoint, transform = transform), ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = div_gradient_pal(low, mid, high, space),
+ na.value = na.value, transform = transform, guide = guide,
+ rescaler = mid_rescaler(mid = midpoint, transform = transform),
+ ...
+ )
}
#' @rdname scale_steps
#' @export
-scale_fill_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50",
- guide = "coloursteps", aesthetics = "fill", colors) {
+scale_fill_stepsn <- function(name = waiver(), ..., colours, values = NULL,
+ space = "Lab", na.value = "grey50",
+ guide = "coloursteps", aesthetics = "fill",
+ colors) {
colours <- if (missing(colours)) colors else colours
- binned_scale(aesthetics, palette = pal_gradient_n(colours, values, space),
- na.value = na.value, guide = guide, ...)
+ binned_scale(
+ aesthetics, name = name,
+ palette = pal_gradient_n(colours, values, space),
+ na.value = na.value, guide = guide, ...
+ )
}
diff --git a/R/scale-viridis.R b/R/scale-viridis.R
index 4647d8f1e7..57b212e07c 100644
--- a/R/scale-viridis.R
+++ b/R/scale-viridis.R
@@ -58,10 +58,11 @@
#' # Use viridis_b to bin continuous data before mapping
#' v + scale_fill_viridis_b()
#'
-scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", aesthetics = "colour") {
+scale_colour_viridis_d <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ aesthetics = "colour") {
discrete_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_viridis(alpha, begin, end, direction, option),
...
)
@@ -69,10 +70,11 @@ scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1,
#' @export
#' @rdname scale_viridis
-scale_fill_viridis_d <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", aesthetics = "fill") {
+scale_fill_viridis_d <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ aesthetics = "fill") {
discrete_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_viridis(alpha, begin, end, direction, option),
...
)
@@ -80,12 +82,13 @@ scale_fill_viridis_d <- function(..., alpha = 1, begin = 0, end = 1,
#' @export
#' @rdname scale_viridis
-scale_colour_viridis_c <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", values = NULL,
- space = "Lab", na.value = "grey50",
- guide = "colourbar", aesthetics = "colour") {
+scale_colour_viridis_c <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ values = NULL, space = "Lab",
+ na.value = "grey50", guide = "colourbar",
+ aesthetics = "colour") {
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(
pal_viridis(alpha, begin, end, direction, option)(6),
values,
@@ -99,12 +102,13 @@ scale_colour_viridis_c <- function(..., alpha = 1, begin = 0, end = 1,
#' @export
#' @rdname scale_viridis
-scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", values = NULL,
- space = "Lab", na.value = "grey50",
- guide = "colourbar", aesthetics = "fill") {
+scale_fill_viridis_c <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ values = NULL, space = "Lab",
+ na.value = "grey50", guide = "colourbar",
+ aesthetics = "fill") {
continuous_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal_gradient_n(
pal_viridis(alpha, begin, end, direction, option)(6),
values,
@@ -118,16 +122,17 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1,
#' @export
#' @rdname scale_viridis
-scale_colour_viridis_b <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", values = NULL,
- space = "Lab", na.value = "grey50",
- guide = "coloursteps", aesthetics = "colour") {
+scale_colour_viridis_b <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ values = NULL, space = "Lab",
+ na.value = "grey50", guide = "coloursteps",
+ aesthetics = "colour") {
pal <- pal_binned(
pal_viridis(alpha, begin, end, direction, option)
)
binned_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal,
na.value = na.value,
guide = guide,
@@ -137,16 +142,17 @@ scale_colour_viridis_b <- function(..., alpha = 1, begin = 0, end = 1,
#' @export
#' @rdname scale_viridis
-scale_fill_viridis_b <- function(..., alpha = 1, begin = 0, end = 1,
- direction = 1, option = "D", values = NULL,
- space = "Lab", na.value = "grey50",
- guide = "coloursteps", aesthetics = "fill") {
+scale_fill_viridis_b <- function(name = waiver(), ..., alpha = 1, begin = 0,
+ end = 1, direction = 1, option = "D",
+ values = NULL, space = "Lab",
+ na.value = "grey50", guide = "coloursteps",
+ aesthetics = "fill") {
pal <- pal_binned(
pal_viridis(alpha, begin, end, direction, option)
)
binned_scale(
- aesthetics,
+ aesthetics, name = name,
palette = pal,
na.value = na.value,
guide = guide,
diff --git a/R/zxx.R b/R/zxx.R
index 080bdfceb2..59b3812e56 100644
--- a/R/zxx.R
+++ b/R/zxx.R
@@ -31,15 +31,14 @@ scale_color_ordinal <- scale_colour_ordinal
#' @export
#' @rdname scale_gradient
#' @usage NULL
-scale_colour_datetime <- function(...,
+scale_colour_datetime <- function(name = waiver(), ...,
low = "#132B43",
high = "#56B1F7",
space = "Lab",
na.value = "grey50",
guide = "colourbar") {
datetime_scale(
- "colour",
- "time",
+ aesthetics = "colour", transform = "time", name = name,
palette = pal_seq_gradient(low, high, space),
na.value = na.value,
guide = guide,
@@ -55,15 +54,15 @@ scale_color_datetime <- scale_colour_datetime
#' @export
#' @rdname scale_gradient
#' @usage NULL
-scale_colour_date <- function(...,
+scale_colour_date <- function(name = waiver(),
+ ...,
low = "#132B43",
high = "#56B1F7",
space = "Lab",
na.value = "grey50",
guide = "colourbar") {
datetime_scale(
- "colour",
- "date",
+ aesthetics = "colour", transform = "date", name = name,
palette = pal_seq_gradient(low, high, space),
na.value = na.value,
guide = guide,
@@ -110,15 +109,14 @@ pal_ordinal <- function(colours, na.color = "grey50", alpha = TRUE) {
#' @export
#' @rdname scale_gradient
#' @usage NULL
-scale_fill_datetime <- function(...,
+scale_fill_datetime <- function(name = waiver(), ...,
low = "#132B43",
high = "#56B1F7",
space = "Lab",
na.value = "grey50",
guide = "colourbar") {
datetime_scale(
- "fill",
- "time",
+ aesthetics = "fill", transform = "time", name = name,
palette = pal_seq_gradient(low, high, space),
na.value = na.value,
guide = guide,
@@ -129,15 +127,14 @@ scale_fill_datetime <- function(...,
#' @export
#' @rdname scale_gradient
#' @usage NULL
-scale_fill_date <- function(...,
+scale_fill_date <- function(name = waiver(), ...,
low = "#132B43",
high = "#56B1F7",
space = "Lab",
na.value = "grey50",
guide = "colourbar") {
datetime_scale(
- "fill",
- "date",
+ aesthetics = "fill", transform = "date", name = name,
palette = pal_seq_gradient(low, high, space),
na.value = na.value,
guide = guide,
diff --git a/man/ggplot2-package.Rd b/man/ggplot2-package.Rd
index 800df0a64a..23ed67a2a5 100644
--- a/man/ggplot2-package.Rd
+++ b/man/ggplot2-package.Rd
@@ -32,6 +32,7 @@ Authors:
\item Kara Woo (\href{https://orcid.org/0000-0002-5125-4188}{ORCID})
\item Hiroaki Yutani (\href{https://orcid.org/0000-0002-3385-7233}{ORCID})
\item Dewey Dunnington (\href{https://orcid.org/0000-0002-9415-4582}{ORCID})
+ \item Teun van den Brand (\href{https://orcid.org/0000-0002-9335-7468}{ORCID})
}
Other contributors:
diff --git a/man/scale_alpha.Rd b/man/scale_alpha.Rd
index f2db5641d1..b9b3160530 100644
--- a/man/scale_alpha.Rd
+++ b/man/scale_alpha.Rd
@@ -10,17 +10,22 @@
\alias{scale_alpha_date}
\title{Alpha transparency scales}
\usage{
-scale_alpha(..., range = c(0.1, 1))
+scale_alpha(name = waiver(), ..., range = c(0.1, 1))
-scale_alpha_continuous(..., range = c(0.1, 1))
+scale_alpha_continuous(name = waiver(), ..., range = c(0.1, 1))
-scale_alpha_binned(..., range = c(0.1, 1))
+scale_alpha_binned(name = waiver(), ..., range = c(0.1, 1))
scale_alpha_discrete(...)
-scale_alpha_ordinal(..., range = c(0.1, 1))
+scale_alpha_ordinal(name = waiver(), ..., range = c(0.1, 1))
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{Other arguments passed on to \code{\link[=continuous_scale]{continuous_scale()}}, \code{\link[=binned_scale]{binned_scale()}},
or \code{\link[=discrete_scale]{discrete_scale()}} as appropriate, to control name, limits,
breaks, labels and so forth.}
diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd
index d63941e0b3..2915ab9741 100644
--- a/man/scale_brewer.Rd
+++ b/man/scale_brewer.Rd
@@ -13,6 +13,7 @@
\title{Sequential, diverging and qualitative colour scales from ColorBrewer}
\usage{
scale_colour_brewer(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -21,6 +22,7 @@ scale_colour_brewer(
)
scale_fill_brewer(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -29,6 +31,7 @@ scale_fill_brewer(
)
scale_colour_distiller(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -41,6 +44,7 @@ scale_colour_distiller(
)
scale_fill_distiller(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -53,6 +57,7 @@ scale_fill_distiller(
)
scale_colour_fermenter(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -63,6 +68,7 @@ scale_colour_fermenter(
)
scale_fill_fermenter(
+ name = waiver(),
...,
type = "seq",
palette = 1,
@@ -73,6 +79,11 @@ scale_fill_fermenter(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}}, \code{\link[=continuous_scale]{continuous_scale()}},
or \code{\link[=binned_scale]{binned_scale()}}, for \code{brewer}, \code{distiller}, and \code{fermenter} variants
respectively, to control name, limits, breaks, labels and so forth.}
diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd
index 0333e4b60a..8cefee4c04 100644
--- a/man/scale_discrete.Rd
+++ b/man/scale_discrete.Rd
@@ -5,11 +5,28 @@
\alias{scale_y_discrete}
\title{Position scales for discrete data}
\usage{
-scale_x_discrete(..., expand = waiver(), guide = waiver(), position = "bottom")
+scale_x_discrete(
+ name = waiver(),
+ ...,
+ expand = waiver(),
+ guide = waiver(),
+ position = "bottom"
+)
-scale_y_discrete(..., expand = waiver(), guide = waiver(), position = "left")
+scale_y_discrete(
+ name = waiver(),
+ ...,
+ expand = waiver(),
+ guide = waiver(),
+ position = "left"
+)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}}
\describe{
@@ -46,10 +63,6 @@ where \code{NA} is always placed at the far right.}
\item{\code{aesthetics}}{The names of the aesthetics that this scale works with.}
\item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale
that should be used for error messages associated with this scale.}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{labels}}{One of:
\itemize{
\item \code{NULL} for no labels
diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd
index 3471bd16e4..ed305e11a3 100644
--- a/man/scale_gradient.Rd
+++ b/man/scale_gradient.Rd
@@ -19,6 +19,7 @@
\title{Gradient colour scales}
\usage{
scale_colour_gradient(
+ name = waiver(),
...,
low = "#132B43",
high = "#56B1F7",
@@ -29,6 +30,7 @@ scale_colour_gradient(
)
scale_fill_gradient(
+ name = waiver(),
...,
low = "#132B43",
high = "#56B1F7",
@@ -39,6 +41,7 @@ scale_fill_gradient(
)
scale_colour_gradient2(
+ name = waiver(),
...,
low = muted("red"),
mid = "white",
@@ -52,6 +55,7 @@ scale_colour_gradient2(
)
scale_fill_gradient2(
+ name = waiver(),
...,
low = muted("red"),
mid = "white",
@@ -65,6 +69,7 @@ scale_fill_gradient2(
)
scale_colour_gradientn(
+ name = waiver(),
...,
colours,
values = NULL,
@@ -76,6 +81,7 @@ scale_colour_gradientn(
)
scale_fill_gradientn(
+ name = waiver(),
...,
colours,
values = NULL,
@@ -87,6 +93,11 @@ scale_fill_gradientn(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=continuous_scale]{continuous_scale}}
\describe{
@@ -95,10 +106,6 @@ that should be used for error messages associated with this scale.}
\item{\code{palette}}{A palette function that when called with a numeric vector with
values between 0 and 1 returns the corresponding output values
(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{breaks}}{One of:
\itemize{
\item \code{NULL} for no breaks
diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd
index 16cbf37e69..99c5f7a5fd 100644
--- a/man/scale_grey.Rd
+++ b/man/scale_grey.Rd
@@ -7,6 +7,7 @@
\title{Sequential grey colour scales}
\usage{
scale_colour_grey(
+ name = waiver(),
...,
start = 0.2,
end = 0.8,
@@ -15,6 +16,7 @@ scale_colour_grey(
)
scale_fill_grey(
+ name = waiver(),
...,
start = 0.2,
end = 0.8,
@@ -23,6 +25,11 @@ scale_fill_grey(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}}
\describe{
@@ -55,10 +62,6 @@ missing values, and do so by default. If you want to remove missing values
from a discrete scale, specify \code{na.translate = FALSE}.}
\item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale
that should be used for error messages associated with this scale.}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{labels}}{One of:
\itemize{
\item \code{NULL} for no labels
diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd
index 480f8434af..f21c69d875 100644
--- a/man/scale_hue.Rd
+++ b/man/scale_hue.Rd
@@ -7,6 +7,7 @@
\title{Evenly spaced colours for discrete data}
\usage{
scale_colour_hue(
+ name = waiver(),
...,
h = c(0, 360) + 15,
c = 100,
@@ -18,6 +19,7 @@ scale_colour_hue(
)
scale_fill_hue(
+ name = waiver(),
...,
h = c(0, 360) + 15,
c = 100,
@@ -29,6 +31,11 @@ scale_fill_hue(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}}
\describe{
@@ -61,10 +68,6 @@ missing values, and do so by default. If you want to remove missing values
from a discrete scale, specify \code{na.translate = FALSE}.}
\item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale
that should be used for error messages associated with this scale.}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{labels}}{One of:
\itemize{
\item \code{NULL} for no labels
diff --git a/man/scale_identity.Rd b/man/scale_identity.Rd
index 5ee1c31dfb..fbc36655c1 100644
--- a/man/scale_identity.Rd
+++ b/man/scale_identity.Rd
@@ -13,25 +13,35 @@
\alias{scale_color_identity}
\title{Use values without scaling}
\usage{
-scale_colour_identity(..., guide = "none", aesthetics = "colour")
+scale_colour_identity(
+ name = waiver(),
+ ...,
+ guide = "none",
+ aesthetics = "colour"
+)
-scale_fill_identity(..., guide = "none", aesthetics = "fill")
+scale_fill_identity(name = waiver(), ..., guide = "none", aesthetics = "fill")
-scale_shape_identity(..., guide = "none")
+scale_shape_identity(name = waiver(), ..., guide = "none")
-scale_linetype_identity(..., guide = "none")
+scale_linetype_identity(name = waiver(), ..., guide = "none")
-scale_linewidth_identity(..., guide = "none")
+scale_linewidth_identity(name = waiver(), ..., guide = "none")
-scale_alpha_identity(..., guide = "none")
+scale_alpha_identity(name = waiver(), ..., guide = "none")
-scale_size_identity(..., guide = "none")
+scale_size_identity(name = waiver(), ..., guide = "none")
-scale_discrete_identity(aesthetics, ..., guide = "none")
+scale_discrete_identity(aesthetics, name = waiver(), ..., guide = "none")
-scale_continuous_identity(aesthetics, ..., guide = "none")
+scale_continuous_identity(aesthetics, name = waiver(), ..., guide = "none")
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}} or
\code{\link[=continuous_scale]{continuous_scale()}}}
diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd
index 21f079255c..0090506482 100644
--- a/man/scale_linetype.Rd
+++ b/man/scale_linetype.Rd
@@ -7,15 +7,20 @@
\alias{scale_linetype_discrete}
\title{Scale for line patterns}
\usage{
-scale_linetype(..., na.value = "blank")
+scale_linetype(name = waiver(), ..., na.value = "blank")
-scale_linetype_binned(..., na.value = "blank")
+scale_linetype_binned(name = waiver(), ..., na.value = "blank")
scale_linetype_continuous(...)
-scale_linetype_discrete(..., na.value = "blank")
+scale_linetype_discrete(name = waiver(), ..., na.value = "blank")
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}}
\describe{
@@ -49,10 +54,6 @@ from a discrete scale, specify \code{na.translate = FALSE}.}
\item{\code{aesthetics}}{The names of the aesthetics that this scale works with.}
\item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale
that should be used for error messages associated with this scale.}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{labels}}{One of:
\itemize{
\item \code{NULL} for no labels
diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd
index 045c726e46..20c65660ed 100644
--- a/man/scale_shape.Rd
+++ b/man/scale_shape.Rd
@@ -8,11 +8,16 @@
\alias{scale_shape_continuous}
\title{Scales for shapes, aka glyphs}
\usage{
-scale_shape(..., solid = TRUE)
+scale_shape(name = waiver(), ..., solid = TRUE)
-scale_shape_binned(..., solid = TRUE)
+scale_shape_binned(name = waiver(), ..., solid = TRUE)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}}
\describe{
@@ -49,10 +54,6 @@ where \code{NA} is always placed at the far right.}
\item{\code{aesthetics}}{The names of the aesthetics that this scale works with.}
\item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale
that should be used for error messages associated with this scale.}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{labels}}{One of:
\itemize{
\item \code{NULL} for no labels
diff --git a/man/scale_size.Rd b/man/scale_size.Rd
index c04338735c..6e941cee46 100644
--- a/man/scale_size.Rd
+++ b/man/scale_size.Rd
@@ -48,9 +48,9 @@ scale_size_binned(
guide = "bins"
)
-scale_size_area(..., max_size = 6)
+scale_size_area(name = waiver(), ..., max_size = 6)
-scale_size_binned_area(..., max_size = 6)
+scale_size_binned_area(name = waiver(), ..., max_size = 6)
}
\arguments{
\item{name}{The name of the scale. Used as the axis or legend title. If
diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd
index b6f5d788d9..97ee769de7 100644
--- a/man/scale_steps.Rd
+++ b/man/scale_steps.Rd
@@ -13,6 +13,7 @@
\title{Binned gradient colour scales}
\usage{
scale_colour_steps(
+ name = waiver(),
...,
low = "#132B43",
high = "#56B1F7",
@@ -23,6 +24,7 @@ scale_colour_steps(
)
scale_colour_steps2(
+ name = waiver(),
...,
low = muted("red"),
mid = "white",
@@ -36,6 +38,7 @@ scale_colour_steps2(
)
scale_colour_stepsn(
+ name = waiver(),
...,
colours,
values = NULL,
@@ -47,6 +50,7 @@ scale_colour_stepsn(
)
scale_fill_steps(
+ name = waiver(),
...,
low = "#132B43",
high = "#56B1F7",
@@ -57,6 +61,7 @@ scale_fill_steps(
)
scale_fill_steps2(
+ name = waiver(),
...,
low = muted("red"),
mid = "white",
@@ -70,6 +75,7 @@ scale_fill_steps2(
)
scale_fill_stepsn(
+ name = waiver(),
...,
colours,
values = NULL,
@@ -81,6 +87,11 @@ scale_fill_stepsn(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{
Arguments passed on to \code{\link[=binned_scale]{binned_scale}}
\describe{
@@ -97,10 +108,6 @@ means that values at break positions are part of the lower bin (open on the
left), whereas they are part of the upper bin when intervals are closed on
the left (open on the right).}
\item{\code{show.limits}}{should the limits of the scale appear as ticks}
- \item{\code{name}}{The name of the scale. Used as the axis or legend title. If
-\code{waiver()}, the default, the name of the scale is taken from the first
-mapping used for that aesthetic. If \code{NULL}, the legend title will be
-omitted.}
\item{\code{breaks}}{One of:
\itemize{
\item \code{NULL} for no breaks
diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd
index aaa029c763..35784d7a1d 100644
--- a/man/scale_viridis.Rd
+++ b/man/scale_viridis.Rd
@@ -16,6 +16,7 @@
\title{Viridis colour scales from viridisLite}
\usage{
scale_colour_viridis_d(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -26,6 +27,7 @@ scale_colour_viridis_d(
)
scale_fill_viridis_d(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -36,6 +38,7 @@ scale_fill_viridis_d(
)
scale_colour_viridis_c(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -50,6 +53,7 @@ scale_colour_viridis_c(
)
scale_fill_viridis_c(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -64,6 +68,7 @@ scale_fill_viridis_c(
)
scale_colour_viridis_b(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -78,6 +83,7 @@ scale_colour_viridis_b(
)
scale_fill_viridis_b(
+ name = waiver(),
...,
alpha = 1,
begin = 0,
@@ -92,6 +98,11 @@ scale_fill_viridis_b(
)
}
\arguments{
+\item{name}{The name of the scale. Used as the axis or legend title. If
+\code{waiver()}, the default, the name of the scale is taken from the first
+mapping used for that aesthetic. If \code{NULL}, the legend title will be
+omitted.}
+
\item{...}{Other arguments passed on to \code{\link[=discrete_scale]{discrete_scale()}},
\code{\link[=continuous_scale]{continuous_scale()}}, or \code{\link[=binned_scale]{binned_scale()}} to control name, limits, breaks,
labels and so forth.}
diff --git a/tests/testthat/test-scale-gradient.R b/tests/testthat/test-scale-gradient.R
index d37cb6d80d..b6da7049bb 100644
--- a/tests/testthat/test-scale-gradient.R
+++ b/tests/testthat/test-scale-gradient.R
@@ -12,11 +12,11 @@ test_that("points outside the limits are plotted as NA", {
test_that("midpoints are transformed", {
- scale <- scale_colour_gradient2(midpoint = 1, trans = "identity")
+ scale <- scale_colour_gradient2(midpoint = 1, transform = "identity")
scale$train(c(0, 3))
expect_equal(scale$rescale(c(0, 3)), c(0.25, 1))
- scale <- scale_colour_gradient2(midpoint = 10, trans = "log10")
+ scale <- scale_colour_gradient2(midpoint = 10, transform = "log10")
scale$train(scale$transform(c(1, 1000)))
ans <- scale$rescale(c(0, 3), c(0.25, 1))
From 204c238333e34d63e56a6b31eacc7af5f9f3051e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 14 Dec 2023 22:46:55 +0100
Subject: [PATCH 2/3] Axes at interior panels #4064 (#4467)
* Add axis drawing to fixed scale facet_wrap
* Add draw.axis argument to facet_grid
* Switch to facet_wrap approach when drawing additional axis in facet_grid
* Document draw.axis argument
* Add unit tests for draw.axes
* resolve conflict
* Rename user-facing argument to 'axes'
* Sync latest changes
* Mechanism for label suppression
* censoring for wrap
* Label censoring for grid
* Test censoring logic
* Label censoring for wrap
* Test logic for wrap censoring
* Visual test for censoring
* Add NEWS bullet
* Better panel spacing with empty panels
* Only draw first in stack
* Funnel radial r-axis through CoordCartesian
* Fix order of theta grobs
* use dot.case instead of snake_case for argument
* use dot.case instead of snake_case for argument
* More snake_case to dot.case conversions
* New args before deprecated args
* add examples
* add `weave_axes` helper
* use helper
---
NEWS.md | 5 +
R/coord-cartesian-.R | 23 +-
R/coord-radial.R | 10 +-
R/facet-.R | 28 ++
R/facet-grid-.R | 87 ++++-
R/facet-wrap.R | 140 +++++--
R/guide-.R | 6 +-
R/guide-axis-stack.R | 14 +-
R/guide-axis-theta.R | 3 +
man/facet_grid.Rd | 14 +
man/facet_wrap.Rd | 16 +-
...et-grid-with-omitted-inner-axis-labels.svg | 347 +++++++++++++++++
...et-wrap-with-omitted-inner-axis-labels.svg | 348 ++++++++++++++++++
tests/testthat/test-facet-.R | 107 ++++++
14 files changed, 1079 insertions(+), 69 deletions(-)
create mode 100644 tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg
create mode 100644 tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
diff --git a/NEWS.md b/NEWS.md
index 5d47b01f86..4bfdf74f6e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,10 @@
# ggplot2 (development version)
+* The new argument `axes` in `facet_grid()` and `facet_wrap()` controls the
+ display of axes at interior panel positions. Additionally, the `axis.labels`
+ argument can be used to only draw tick marks or fully labelled axes
+ (@teunbrand, #4064).
+
* The `name` argument in most scales is now explicitly the first argument
(#5535)
diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R
index 95e125cdc0..74f46433db 100644
--- a/R/coord-cartesian-.R
+++ b/R/coord-cartesian-.R
@@ -117,15 +117,27 @@ CoordCartesian <- ggproto("CoordCartesian", Coord,
render_axis_h = function(panel_params, theme) {
list(
- top = panel_guides_grob(panel_params$guides, position = "top", theme = theme),
- bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme)
+ top = panel_guides_grob(
+ panel_params$guides, position = "top",
+ theme = theme, labels = panel_params$draw_labels$top
+ ),
+ bottom = panel_guides_grob(
+ panel_params$guides, position = "bottom",
+ theme = theme, labels = panel_params$draw_labels$bottom
+ )
)
},
render_axis_v = function(panel_params, theme) {
list(
- left = panel_guides_grob(panel_params$guides, position = "left", theme = theme),
- right = panel_guides_grob(panel_params$guides, position = "right", theme = theme)
+ left = panel_guides_grob(
+ panel_params$guides, position = "left",
+ theme = theme, labels = panel_params$draw_labels$left
+ ),
+ right = panel_guides_grob(
+ panel_params$guides, position = "right",
+ theme = theme, labels = panel_params$draw_labels$right
+ )
)
}
)
@@ -146,10 +158,11 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
view_scales
}
-panel_guides_grob <- function(guides, position, theme) {
+panel_guides_grob <- function(guides, position, theme, labels = NULL) {
if (!inherits(guides, "Guides")) {
return(zeroGrob())
}
pair <- guides$get_position(position)
+ pair$params$draw_label <- labels %||% NULL
pair$guide$draw(theme, params = pair$params)
}
diff --git a/R/coord-radial.R b/R/coord-radial.R
index 9f2ede8cce..1f0c778e5f 100644
--- a/R/coord-radial.R
+++ b/R/coord-radial.R
@@ -241,20 +241,14 @@ CoordRadial <- ggproto("CoordRadial", Coord,
if (self$r_axis_inside) {
return(list(left = zeroGrob(), right = zeroGrob()))
}
- list(
- left = panel_guides_grob(panel_params$guides, position = "left", theme = theme),
- right = panel_guides_grob(panel_params$guides, position = "right", theme = theme)
- )
+ CoordCartesian$render_axis_v(panel_params, theme)
},
render_axis_h = function(self, panel_params, theme) {
if (self$r_axis_inside) {
return(list(top = zeroGrob(), bottom = zeroGrob()))
}
- list(
- top = panel_guides_grob(panel_params$guides, position = "top", theme = theme),
- bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme)
- )
+ CoordCartesian$render_axis_h(panel_params, theme)
},
render_bg = function(self, panel_params, theme) {
diff --git a/R/facet-.R b/R/facet-.R
index f26b602f89..c2d7dc8df7 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -701,3 +701,31 @@ render_strips <- function(x = NULL, y = NULL, labeller, theme) {
y = build_strip(y, labeller, theme, FALSE)
)
}
+
+
+censor_labels <- function(ranges, layout, labels) {
+ if (labels$x && labels$y) {
+ return(ranges)
+ }
+ draw <- matrix(
+ TRUE, length(ranges), 4,
+ dimnames = list(NULL, c("top", "bottom", "left", "right"))
+ )
+
+ if (!labels$x) {
+ xmax <- stats::ave(layout$ROW, layout$COL, FUN = max)
+ xmin <- stats::ave(layout$ROW, layout$COL, FUN = min)
+ draw[which(layout$ROW != xmax), "bottom"] <- FALSE
+ draw[which(layout$ROW != xmin), "top"] <- FALSE
+ }
+ if (!labels$y) {
+ ymax <- stats::ave(layout$COL, layout$ROW, FUN = max)
+ ymin <- stats::ave(layout$COL, layout$ROW, FUN = min)
+ draw[which(layout$COL != ymax), "right"] <- FALSE
+ draw[which(layout$COL != ymin), "left"] <- FALSE
+ }
+ for (i in seq_along(ranges)) {
+ ranges[[i]]$draw_labels <- as.list(draw[i, ])
+ }
+ ranges
+}
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index 4afccc71f8..823170d0ce 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -59,6 +59,16 @@ NULL
#' variables for which margins are to be created.
#' @param facets `r lifecycle::badge("deprecated")` Please use `rows`
#' and `cols` instead.
+#' @param axes Determines which axes will be drawn. When `"margins"`
+#' (default), axes will be drawn at the exterior margins. `"all_x"` and
+#' `"all_y"` will draw the respective axes at the interior panels too, whereas
+#' `"all"` will draw all axes at all panels.
+#' @param axis.labels Determines whether to draw labels for interior axes when
+#' the `axes` argument is not `"margins"`. When `"all"` (default), all
+#' interior axes get labels. When `"margins"`, only the exterior axes get
+#' labels and the interior axes get none. When `"all_x"` or `"all_y"`, only
+#' draws the labels at the interior axes in the x- or y-direction
+#' respectively.
#' @export
#' @examples
#' p <- ggplot(mpg, aes(displ, cty)) + geom_point()
@@ -79,6 +89,12 @@ NULL
#' facet_grid(cols = vars(cyl)) +
#' geom_point(data = df, colour = "red", size = 2)
#'
+#' # When scales are constant, duplicated axes can be shown with
+#' # or without labels
+#' ggplot(mpg, aes(cty, hwy)) +
+#' geom_point() +
+#' facet_grid(year ~ drv, axes = "all", axis.labels = "all_x")
+#'
#' # Free scales -------------------------------------------------------
#' # You can also choose whether the scales should be constant
#' # across all panels (the default), or whether they should be allowed
@@ -112,6 +128,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
space = "fixed", shrink = TRUE,
labeller = "label_value", as.table = TRUE,
switch = NULL, drop = TRUE, margins = FALSE,
+ axes = "margins", axis.labels = "all",
facets = deprecated()) {
# `facets` is deprecated and renamed to `rows`
if (lifecycle::is_present(facets)) {
@@ -137,6 +154,20 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
y = any(space %in% c("free_y", "free"))
)
+ draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+ draw_axes <- list(
+ x = any(draw_axes %in% c("all_x", "all")),
+ y = any(draw_axes %in% c("all_y", "all"))
+ )
+
+ # Omitting labels is special-cased internally, so even when no internal axes
+ # are to be drawn, register as labelled.
+ axis_labels <- arg_match0(axis.labels, c("margins", "all_x", "all_y", "all"))
+ axis_labels <- list(
+ x = !draw_axes$x || any(axis_labels %in% c("all_x", "all")),
+ y = !draw_axes$y || any(axis_labels %in% c("all_y", "all"))
+ )
+
if (!is.null(switch)) {
arg_match0(switch, c("both", "x", "y"))
}
@@ -150,7 +181,8 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
shrink = shrink,
params = list(rows = facets_list$rows, cols = facets_list$cols, margins = margins,
free = free, space_free = space_free, labeller = labeller,
- as.table = as.table, switch = switch, drop = drop)
+ as.table = as.table, switch = switch, drop = drop,
+ draw_axes = draw_axes, axis_labels = axis_labels)
)
}
@@ -306,8 +338,22 @@ FacetGrid <- ggproto("FacetGrid", Facet,
cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales.")
}
- cols <- which(layout$ROW == 1)
- rows <- which(layout$COL == 1)
+ if (!params$axis_labels$x) {
+ cols <- seq_len(nrow(layout))
+ x_axis_order <- as.integer(layout$PANEL[order(layout$ROW, layout$COL)])
+ } else {
+ cols <- which(layout$ROW == 1)
+ x_axis_order <- layout$COL
+ }
+ if (!params$axis_labels$y) {
+ rows <- seq_len(nrow(layout))
+ y_axis_order <- as.integer(layout$PANEL[order(layout$ROW, layout$COL)])
+ } else {
+ rows <- which(layout$COL == 1)
+ y_axis_order <- layout$ROW
+ }
+
+ ranges <- censor_labels(ranges, layout, params$axis_labels)
axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
col_vars <- unique0(layout[names(params$cols)])
@@ -334,7 +380,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
}
ncol <- max(layout$COL)
nrow <- max(layout$ROW)
- panel_table <- matrix(panels, nrow = nrow, ncol = ncol, byrow = TRUE)
+ mtx <- function(x) matrix(x, nrow = nrow, ncol = ncol, byrow = TRUE)
+ panel_table <- mtx(panels)
# @kohske
# Now size of each panel is calculated using PANEL$ranges, which is given by
@@ -358,7 +405,7 @@ FacetGrid <- ggproto("FacetGrid", Facet,
}
panel_table <- gtable_matrix("layout", panel_table,
- panel_widths, panel_heights, respect = respect, clip = coord$clip, z = matrix(1, ncol = ncol, nrow = nrow))
+ panel_widths, panel_heights, respect = respect, clip = coord$clip, z = mtx(1))
panel_table$layout$name <- paste0('panel-', rep(seq_len(nrow), ncol), '-', rep(seq_len(ncol), each = nrow))
panel_table <- gtable_add_col_space(panel_table,
@@ -367,17 +414,27 @@ FacetGrid <- ggproto("FacetGrid", Facet,
theme$panel.spacing.y %||% theme$panel.spacing)
# Add axes
- panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
- panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
- panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
- panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
- panel_pos_col <- panel_cols(panel_table)
- panel_pos_rows <- panel_rows(panel_table)
+ if (params$draw_axes$x) {
+ axes$x <- lapply(axes$x, function(x) mtx(x[x_axis_order]))
+ panel_table <- weave_axes(panel_table, axes$x)$panels
+ } else {
+ panel_table <- gtable_add_rows(panel_table, max_height(axes$x$top), 0)
+ panel_table <- gtable_add_rows(panel_table, max_height(axes$x$bottom), -1)
+ panel_pos_col <- panel_cols(panel_table)
+ panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off", name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
+ panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off", name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
+ }
- panel_table <- gtable_add_grob(panel_table, axes$x$top, 1, panel_pos_col$l, clip = "off", name = paste0("axis-t-", seq_along(axes$x$top)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$x$bottom, -1, panel_pos_col$l, clip = "off", name = paste0("axis-b-", seq_along(axes$x$bottom)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off", name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
- panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off", name = paste0("axis-r-", seq_along(axes$y$right)), z= 3)
+ if (params$draw_axes$y) {
+ axes$y <- lapply(axes$y, function(y) mtx(y[y_axis_order]))
+ panel_table <- weave_axes(panel_table, axes$y)$panels
+ } else {
+ panel_table <- gtable_add_cols(panel_table, max_width(axes$y$left), 0)
+ panel_table <- gtable_add_cols(panel_table, max_width(axes$y$right), -1)
+ panel_pos_rows <- panel_rows(panel_table)
+ panel_table <- gtable_add_grob(panel_table, axes$y$left, panel_pos_rows$t, 1, clip = "off", name = paste0("axis-l-", seq_along(axes$y$left)), z = 3)
+ panel_table <- gtable_add_grob(panel_table, axes$y$right, panel_pos_rows$t, -1, clip = "off", name = paste0("axis-r-", seq_along(axes$y$right)), z= 3)
+ }
# Add strips
switch_x <- !is.null(params$switch) && params$switch %in% c("both", "x")
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 00c65dd49a..6058a57ad6 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -24,6 +24,16 @@ NULL
#' "bottom", "left", "right")}
#' @param dir Direction: either `"h"` for horizontal, the default, or `"v"`,
#' for vertical.
+#' @param axes Determines which axes will be drawn in case of fixed scales.
+#' When `"margins"` (default), axes will be drawn at the exterior margins.
+#' `"all_x"` and `"all_y"` will draw the respective axes at the interior
+#' panels too, whereas `"all"` will draw all axes at all panels.
+#' @param axis.labels Determines whether to draw labels for interior axes when
+#' the scale is fixed and the `axis` argument is not `"margins"`. When
+#' `"all"` (default), all interior axes get labels. When `"margins"`, only
+#' the exterior axes get labels, and the interior axes get none. When
+#' `"all_x"` or `"all_y"`, only draws the labels at the interior axes in the
+#' x- or y-direction respectively.
#' @inheritParams facet_grid
#' @export
#' @examples
@@ -61,6 +71,12 @@ NULL
#' geom_point() +
#' facet_wrap(vars(class), scales = "free")
#'
+#' # When scales are constant, duplicated axes can be shown with
+#' # or without labels
+#' ggplot(mpg, aes(displ, hwy)) +
+#' geom_point() +
+#' facet_wrap(vars(class), axes = "all", axis.labels = "all_y")
+#'
#' # To repeat the same data in every panel, simply construct a data frame
#' # that does not contain the faceting variable.
#' ggplot(mpg, aes(displ, hwy)) +
@@ -80,7 +96,8 @@ NULL
facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
shrink = TRUE, labeller = "label_value", as.table = TRUE,
switch = deprecated(), drop = TRUE, dir = "h",
- strip.position = 'top') {
+ strip.position = 'top', axes = "margins",
+ axis.labels = "all") {
scales <- arg_match0(scales %||% "fixed", c("fixed", "free_x", "free_y", "free"))
dir <- arg_match0(dir, c("h", "v"))
free <- list(
@@ -88,6 +105,21 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
y = any(scales %in% c("free_y", "free"))
)
+ # If scales are free, always draw the axes
+ draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all"))
+ draw_axes <- list(
+ x = free$x || any(draw_axes %in% c("all_x", "all")),
+ y = free$y || any(draw_axes %in% c("all_y", "all"))
+ )
+
+ # Omitting labels is special-cased internally, so only omit labels if
+ # scales are not free and the axis is to be drawn
+ axis_labels <- arg_match0(axis.labels, c("margins", "all_x", "all_y", "all"))
+ axis_labels <- list(
+ x = free$x || !draw_axes$x || any(axis_labels %in% c("all_x", "all")),
+ y = free$y || !draw_axes$y || any(axis_labels %in% c("all_y", "all"))
+ )
+
# Check for deprecated labellers
labeller <- check_labeller(labeller)
@@ -121,7 +153,9 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
ncol = ncol,
nrow = nrow,
labeller = labeller,
- dir = dir
+ dir = dir,
+ draw_axes = draw_axes,
+ axis_labels = axis_labels
)
)
}
@@ -241,6 +275,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
panels <- panels[panel_order]
panel_pos <- convertInd(layout$ROW, layout$COL, nrow)
+ x_axis_order <- if (params$axis_labels$x) layout$SCALE_X else seq(n)
+ y_axis_order <- if (params$axis_labels$y) layout$SCALE_Y else seq(n)
+
+ ranges <- censor_labels(ranges, layout, params$axis_labels)
axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
if (length(params$facets) == 0) {
@@ -285,37 +323,23 @@ FacetWrap <- ggproto("FacetWrap", Facet,
# Add axes
axis_mat_x_top <- empty_table
- axis_mat_x_top[panel_pos] <- axes$x$top[layout$SCALE_X]
+ axis_mat_x_top[panel_pos] <- axes$x$top[x_axis_order]
axis_mat_x_bottom <- empty_table
- axis_mat_x_bottom[panel_pos] <- axes$x$bottom[layout$SCALE_X]
+ axis_mat_x_bottom[panel_pos] <- axes$x$bottom[x_axis_order]
axis_mat_y_left <- empty_table
- axis_mat_y_left[panel_pos] <- axes$y$left[layout$SCALE_Y]
+ axis_mat_y_left[panel_pos] <- axes$y$left[y_axis_order]
axis_mat_y_right <- empty_table
- axis_mat_y_right[panel_pos] <- axes$y$right[layout$SCALE_Y]
- if (!params$free$x) {
+ axis_mat_y_right[panel_pos] <- axes$y$right[y_axis_order]
+ if (!(params$free$x || params$draw_axes$x)) {
axis_mat_x_top[-1,]<- list(zeroGrob())
axis_mat_x_bottom[-nrow,]<- list(zeroGrob())
}
- if (!params$free$y) {
+ if (!(params$free$y || params$draw_axes$y)) {
axis_mat_y_left[, -1] <- list(zeroGrob())
axis_mat_y_right[, -ncol] <- list(zeroGrob())
}
- axis_height_top <- unit(
- apply(axis_mat_x_top, 1, max_height, value_only = TRUE),
- "cm"
- )
- axis_height_bottom <- unit(
- apply(axis_mat_x_bottom, 1, max_height, value_only = TRUE),
- "cm"
- )
- axis_width_left <- unit(
- apply(axis_mat_y_left, 2, max_width, value_only = TRUE),
- "cm"
- )
- axis_width_right <- unit(
- apply(axis_mat_y_right, 2, max_width, value_only = TRUE),
- "cm"
- )
+
+
# Add back missing axes
if (any(empties)) {
row_ind <- row(empties)
@@ -330,7 +354,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- x_axes <- axes$x$bottom[layout$SCALE_X[panels]]
+ x_axes <- axes$x$bottom[x_axis_order[panels]]
if (params$strip.position == "bottom" &&
!inside &&
any(!vapply(x_axes, is.zero, logical(1))) &&
@@ -349,7 +373,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- x_axes <- axes$x$top[layout$SCALE_X[panels]]
+ x_axes <- axes$x$top[x_axis_order[panels]]
if (params$strip.position == "top" &&
!inside &&
any(!vapply(x_axes, is.zero, logical(1))) &&
@@ -368,7 +392,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- y_axes <- axes$y$right[layout$SCALE_Y[panels]]
+ y_axes <- axes$y$right[y_axis_order[panels]]
if (params$strip.position == "right" &&
!inside &&
any(!vapply(y_axes, is.zero, logical(1))) &&
@@ -387,7 +411,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
.size = length(pos)
)
panels <- vec_match(panel_loc, layout[, c("ROW", "COL")])
- y_axes <- axes$y$left[layout$SCALE_Y[panels]]
+ y_axes <- axes$y$left[y_axis_order[panels]]
if (params$strip.position == "left" &&
!inside &&
any(!vapply(y_axes, is.zero, logical(1))) &&
@@ -398,10 +422,16 @@ FacetWrap <- ggproto("FacetWrap", Facet,
}
}
}
- panel_table <- weave_tables_row(panel_table, axis_mat_x_top, -1, axis_height_top, "axis-t", 3)
- panel_table <- weave_tables_row(panel_table, axis_mat_x_bottom, 0, axis_height_bottom, "axis-b", 3)
- panel_table <- weave_tables_col(panel_table, axis_mat_y_left, -1, axis_width_left, "axis-l", 3)
- panel_table <- weave_tables_col(panel_table, axis_mat_y_right, 0, axis_width_right, "axis-r", 3)
+ panel_table <- weave_axes(
+ panel_table,
+ axes = list(
+ top = axis_mat_x_top, bottom = axis_mat_x_bottom,
+ left = axis_mat_y_left, right = axis_mat_y_right
+ ),
+ empty = empties
+ )
+ axis_size <- panel_table$sizes
+ panel_table <- panel_table$panels
strip_padding <- convertUnit(theme$strip.switch.pad.wrap, "cm")
strip_name <- paste0("strip-", substr(params$strip.position, 1, 1))
@@ -411,10 +441,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
inside_x <- (theme$strip.placement.x %||% theme$strip.placement %||% "inside") == "inside"
if (params$strip.position == "top") {
placement <- if (inside_x) -1 else -2
- strip_pad <- axis_height_top
+ strip_pad <- axis_size$top
} else {
placement <- if (inside_x) 0 else 1
- strip_pad <- axis_height_bottom
+ strip_pad <- axis_size$bottom
}
strip_height <- unit(apply(strip_mat, 1, max_height, value_only = TRUE), "cm")
panel_table <- weave_tables_row(panel_table, strip_mat, placement, strip_height, strip_name, 2, coord$clip)
@@ -426,10 +456,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
inside_y <- (theme$strip.placement.y %||% theme$strip.placement %||% "inside") == "inside"
if (params$strip.position == "left") {
placement <- if (inside_y) -1 else -2
- strip_pad <- axis_width_left
+ strip_pad <- axis_size$left
} else {
placement <- if (inside_y) 0 else 1
- strip_pad <- axis_width_right
+ strip_pad <- axis_size$right
}
strip_pad[as.numeric(strip_pad) != 0] <- strip_padding
strip_width <- unit(apply(strip_mat, 2, max_width, value_only = TRUE), "cm")
@@ -505,3 +535,41 @@ weave_tables_row <- function(table, table2, row_shift, row_height, name, z = 1,
}
table
}
+
+weave_axes <- function(panels, axes, empty = NULL, z = 3L) {
+ empty <- which(empty %||% matrix(logical(), 0, 0), arr.ind = TRUE)
+ sides <- match(names(axes), .trbl)
+ margin <- c(1L, 2L, 1L, 2L)[sides]
+ shift <- c(1L, -1L, -1L, 1L)[sides]
+ sizes <- Map(
+ measure_axes, axis = axes, margin = margin, shift = shift,
+ MoreArgs = list(empty_idx = empty)
+ )
+ names <- paste0("axis-", substr(names(axes), 1, 1))
+ shift <- c(-1L, 0L, 0L, -1L)[sides]
+ weave <- list(weave_tables_row, weave_tables_col)[c(1, 2, 1, 2)][sides]
+ for (i in seq_along(axes)) {
+ panels <- weave[[i]](panels, axes[[i]], shift[i], sizes[[i]], names[i], z = z)
+ }
+ list(panels = panels, sizes = sizes)
+}
+
+# Measures the size of axes while ignoring those bordering empty panels
+measure_axes <- function(empty_idx, axis, margin = 1L, shift = 0) {
+ dim <- dim(axis)
+
+ measure <- switch(margin, height_cm, width_cm)
+ cm <- matrix(measure(axis), dim[1], dim[2])
+
+ if (nrow(empty_idx) > 0 && shift != 0) {
+ set_zero <- empty_idx
+ set_zero[, margin] <- set_zero[, margin] + shift
+ keep <- set_zero[, margin] <= dim[margin] & set_zero[, margin] > 0
+ set_zero <- set_zero[keep, , drop = FALSE]
+ } else {
+ set_zero <- matrix(integer(), nrow = 0, ncol = 2)
+ }
+
+ cm[set_zero] <- 0
+ unit(apply(cm, margin, max), "cm")
+}
diff --git a/R/guide-.R b/R/guide-.R
index b90c7b93f4..e185ec67b0 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -314,9 +314,13 @@ Guide <- ggproto(
# Build grobs
grobs <- list(
title = self$build_title(params$title, elems, params),
- labels = self$build_labels(key, elems, params),
ticks = self$build_ticks(key, elems, params)
)
+ if (params$draw_label %||% TRUE) {
+ grobs$labels <- self$build_labels(key, elems, params)
+ } else {
+ grobs$labels <- list(zeroGrob())
+ }
grobs$decor <- self$build_decor(params$decor, grobs, elems, params)
# Arrange and assemble grobs
diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R
index 1e0f765898..7c345dff20 100644
--- a/R/guide-axis-stack.R
+++ b/R/guide-axis-stack.R
@@ -149,6 +149,11 @@ GuideAxisStack <- ggproto(
position <- params$position %||% position
direction <- params$direction %||% direction
+ # If we are instructed to not draw labels at interior panels, just render
+ # the first axis
+ draw_label <- params$draw_label %||% TRUE
+ guide_index <- if (draw_label) seq_along(params$guides) else 1L
+
if (position %in% c("theta", "theta.sec")) {
# If we are a theta guide, we need to keep track how much space in the
# radial direction a guide occupies, and add that as an offset to the
@@ -156,7 +161,8 @@ GuideAxisStack <- ggproto(
offset <- unit(0, "cm")
spacing <- params$spacing %||% unit(2.25, "pt")
grobs <- list()
- for (i in seq_along(params$guides)) {
+
+ for (i in guide_index) {
# Add offset to params
pars <- params$guide_params[[i]]
pars$stack_offset <- offset
@@ -177,10 +183,12 @@ GuideAxisStack <- ggproto(
# Loop through every guide's draw method
grobs <- list()
- for (i in seq_along(params$guides)) {
+ for (i in guide_index) {
+ pars <- params$guide_params[[i]]
+ pars$draw_label <- draw_label
grobs[[i]] <- params$guides[[i]]$draw(
theme, position = position, direction = direction,
- params = params$guide_params[[i]]
+ params = pars
)
}
diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R
index e8f4504050..306eab61af 100644
--- a/R/guide-axis-theta.R
+++ b/R/guide-axis-theta.R
@@ -308,6 +308,9 @@ GuideAxisTheta <- ggproto(
assemble_drawing = function(grobs, layout, sizes, params, elements) {
+ # Fix order of grobs
+ grobs <- grobs[c("title", "labels", "ticks", "decor")]
+
if (params$position %in% c("theta", "theta.sec")) {
# We append an 'offset' slot in case this guide is part
# of a stacked guide
diff --git a/man/facet_grid.Rd b/man/facet_grid.Rd
index a485a8a491..3b5b5becc7 100644
--- a/man/facet_grid.Rd
+++ b/man/facet_grid.Rd
@@ -15,6 +15,8 @@ facet_grid(
switch = NULL,
drop = TRUE,
margins = FALSE,
+ axes = "margins",
+ axis.labels = "all",
facets = deprecated()
)
}
@@ -77,6 +79,18 @@ default). If \code{TRUE}, margins are included for all faceting
variables. If specified as a character vector, it is the names of
variables for which margins are to be created.}
+\item{axes}{Determines which axes will be drawn. When \code{"margins"}
+(default), axes will be drawn at the exterior margins. \code{"all_x"} and
+\code{"all_y"} will draw the respective axes at the interior panels too, whereas
+\code{"all"} will draw all axes at all panels.}
+
+\item{axis.labels}{Determines whether to draw labels for interior axes when
+the \code{axes} argument is not \code{"margins"}. When \code{"all"} (default), all
+interior axes get labels. When \code{"margins"}, only the exterior axes get
+labels and the interior axes get none. When \code{"all_x"} or \code{"all_y"}, only
+draws the labels at the interior axes in the x- or y-direction
+respectively.}
+
\item{facets}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use \code{rows}
and \code{cols} instead.}
}
diff --git a/man/facet_wrap.Rd b/man/facet_wrap.Rd
index 432884db5d..ed97d6e374 100644
--- a/man/facet_wrap.Rd
+++ b/man/facet_wrap.Rd
@@ -15,7 +15,9 @@ facet_wrap(
switch = deprecated(),
drop = TRUE,
dir = "h",
- strip.position = "top"
+ strip.position = "top",
+ axes = "margins",
+ axis.labels = "all"
)
}
\arguments{
@@ -69,6 +71,18 @@ for vertical.}
the plot. Using \code{strip.position} it is possible to place the labels on
either of the four sides by setting \code{strip.position = c("top",
"bottom", "left", "right")}}
+
+\item{axes}{Determines which axes will be drawn in case of fixed scales.
+When \code{"margins"} (default), axes will be drawn at the exterior margins.
+\code{"all_x"} and \code{"all_y"} will draw the respective axes at the interior
+panels too, whereas \code{"all"} will draw all axes at all panels.}
+
+\item{axis.labels}{Determines whether to draw labels for interior axes when
+the scale is fixed and the \code{axis} argument is not \code{"margins"}. When
+\code{"all"} (default), all interior axes get labels. When \code{"margins"}, only
+the exterior axes get labels, and the interior axes get none. When
+\code{"all_x"} or \code{"all_y"}, only draws the labels at the interior axes in the
+x- or y-direction respectively.}
}
\description{
\code{facet_wrap()} wraps a 1d sequence of panels into 2d. This is generally
diff --git a/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg
new file mode 100644
index 0000000000..4cdc17ce98
--- /dev/null
+++ b/tests/testthat/_snaps/facet-/facet-grid-with-omitted-inner-axis-labels.svg
@@ -0,0 +1,347 @@
+
+
diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
new file mode 100644
index 0000000000..66caee5c07
--- /dev/null
+++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
@@ -0,0 +1,348 @@
+
+
diff --git a/tests/testthat/test-facet-.R b/tests/testthat/test-facet-.R
index 49c1316104..5d4b176b6b 100644
--- a/tests/testthat/test-facet-.R
+++ b/tests/testthat/test-facet-.R
@@ -235,6 +235,96 @@ test_that("facet gives clear error if ", {
expect_snapshot_error(print(ggplot(df, aes(x)) + facet_grid(vars(x), "free")))
})
+test_that("facet_grid `axis_labels` argument can be overruled", {
+
+ f <- facet_grid(vars(cyl), axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_grid(vars(cyl), axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = FALSE, y = FALSE))
+
+ # Overrule when only drawing at margins
+ f <- facet_grid(vars(cyl), axes = "margins", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+})
+
+test_that("facet_wrap `axis_labels` argument can be overruled", {
+
+ # The folllowing three should all draw axis labels
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_wrap(vars(cyl), scales = "free", axes = "all", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "margins", axis.labels = "all")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ # The only case when labels shouldn't be drawn is when scales are fixed but
+ # the axes are to be drawn
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = FALSE, y = FALSE))
+
+ # Should draw labels because scales are free
+ f <- facet_wrap(vars(cyl), scales = "free", axes = "all", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+ # Should draw labels because only drawing at margins
+ f <- facet_wrap(vars(cyl), scales = "fixed", axes = "margins", axis.labels = "margins")
+ expect_equal(f$params$axis_labels, list(x = TRUE, y = TRUE))
+
+})
+
+test_that("facet_grid `axes` can draw inner axes.", {
+ df <- data_frame(
+ x = 1:4, y = 1:4,
+ fx = c("A", "A", "B", "B"),
+ fy = c("c", "d", "c", "d")
+ )
+ p <- ggplot(df, aes(x, y)) + geom_point()
+
+ case <- ggplotGrob(p + facet_grid(vars(fy), vars(fx), axes = "all"))
+ ctrl <- ggplotGrob(p + facet_grid(vars(fy), vars(fx), axes = "margins"))
+
+ # 4 x-axes if all axes should be drawn
+ bottom <- case$grobs[grepl("axis-b", case$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 4)
+ # 2 x-axes if drawing at the margins
+ bottom <- ctrl$grobs[grepl("axis-b", ctrl$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 2)
+
+ # Ditto for y-axes
+ left <- case$grobs[grepl("axis-l", case$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 4)
+ left <- ctrl$grobs[grepl("axis-l", ctrl$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 2)
+})
+
+test_that("facet_wrap `axes` can draw inner axes.", {
+ df <- data_frame(
+ x = 1, y = 1, facet = LETTERS[1:4]
+ )
+
+ p <- ggplot(df, aes(x, y)) + geom_point()
+
+ case <- ggplotGrob(p + facet_wrap(vars(facet), axes = "all"))
+ ctrl <- ggplotGrob(p + facet_wrap(vars(facet), axes = "margins"))
+
+ # 4 x-axes if all axes should be drawn
+ bottom <- case$grobs[grepl("axis-b", case$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 4)
+ # 2 x-axes if drawing at the margins
+ bottom <- ctrl$grobs[grepl("axis-b", ctrl$layout$name)]
+ expect_equal(sum(vapply(bottom, inherits, logical(1), "absoluteGrob")), 2)
+
+ # Ditto for y-axes
+ left <- case$grobs[grepl("axis-l", case$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 4)
+ left <- ctrl$grobs[grepl("axis-l", ctrl$layout$name)]
+ expect_equal(sum(vapply(left, inherits, logical(1), "absoluteGrob")), 2)
+})
+
# Variable combinations ---------------------------------------------------
test_that("zero-length vars in combine_vars() generates zero combinations", {
@@ -413,3 +503,20 @@ test_that("facet labels respect both justification and margin arguments", {
expect_doppelganger("left justified facet labels with margins", p1)
expect_doppelganger("left justified rotated facet labels with margins", p2)
})
+
+test_that("facet's 'axis_labels' argument correctly omits labels", {
+
+ base <- ggplot(mtcars, aes(mpg, disp)) +
+ geom_point() +
+ guides(x = "axis", y = "axis", x.sec = "axis", y.sec = "axis")
+
+ expect_doppelganger(
+ "facet_grid with omitted inner axis labels",
+ base + facet_grid(vars(cyl), vars(vs), axes = "all", axis.labels = "margins")
+ )
+
+ expect_doppelganger(
+ "facet_wrap with omitted inner axis labels",
+ base + facet_wrap(vars(cyl, vs), axes = "all", axis.labels = "margins")
+ )
+})
From 4946960e0152d84f9908c10b25dbd7b23b122eb8 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Fri, 15 Dec 2023 08:40:46 +0100
Subject: [PATCH 3/3] export `GuideAxisTheta` (#5584)
---
NAMESPACE | 1 +
R/guide-axis-theta.R | 4 ++++
man/ggplot2-ggproto.Rd | 26 ++++++++++++++------------
3 files changed, 19 insertions(+), 12 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
index 6a9893e917..960f0cfe5c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -221,6 +221,7 @@ export(Guide)
export(GuideAxis)
export(GuideAxisLogticks)
export(GuideAxisStack)
+export(GuideAxisTheta)
export(GuideBins)
export(GuideColourbar)
export(GuideColoursteps)
diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R
index 306eab61af..79f5b2dea1 100644
--- a/R/guide-axis-theta.R
+++ b/R/guide-axis-theta.R
@@ -53,6 +53,10 @@ guide_axis_theta <- function(title = waiver(), theme = NULL, angle = waiver(),
)
}
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
GuideAxisTheta <- ggproto(
"GuideAxisTheta", GuideAxis,
diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd
index d7ca283a92..282ab4e5ce 100644
--- a/man/ggplot2-ggproto.Rd
+++ b/man/ggplot2-ggproto.Rd
@@ -14,18 +14,19 @@
% R/geom-quantile.R, R/geom-rug.R, R/geom-smooth.R, R/geom-spoke.R,
% R/geom-text.R, R/geom-tile.R, R/geom-violin.R, R/geom-vline.R,
% R/guide-.R, R/guide-axis.R, R/guide-axis-logticks.R, R/guide-axis-stack.R,
-% R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R,
-% R/guide-custom.R, R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R,
-% R/position-dodge.R, R/position-dodge2.R, R/position-identity.R,
-% R/position-jitter.R, R/position-jitterdodge.R, R/position-nudge.R,
-% R/position-stack.R, R/scale-.R, R/scale-binned.R, R/scale-continuous.R,
-% R/scale-date.R, R/scale-discrete-.R, R/scale-identity.R, R/stat-align.R,
-% R/stat-bin.R, R/stat-bin2d.R, R/stat-bindot.R, R/stat-binhex.R,
-% R/stat-boxplot.R, R/stat-contour.R, R/stat-count.R, R/stat-density-2d.R,
-% R/stat-density.R, R/stat-ecdf.R, R/stat-ellipse.R, R/stat-function.R,
-% R/stat-identity.R, R/stat-qq-line.R, R/stat-qq.R, R/stat-quantilemethods.R,
-% R/stat-smooth.R, R/stat-sum.R, R/stat-summary-2d.R, R/stat-summary-bin.R,
-% R/stat-summary-hex.R, R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R
+% R/guide-axis-theta.R, R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R,
+% R/guide-colorsteps.R, R/guide-custom.R, R/guide-none.R, R/guide-old.R,
+% R/layout.R, R/position-.R, R/position-dodge.R, R/position-dodge2.R,
+% R/position-identity.R, R/position-jitter.R, R/position-jitterdodge.R,
+% R/position-nudge.R, R/position-stack.R, R/scale-.R, R/scale-binned.R,
+% R/scale-continuous.R, R/scale-date.R, R/scale-discrete-.R,
+% R/scale-identity.R, R/stat-align.R, R/stat-bin.R, R/stat-bin2d.R,
+% R/stat-bindot.R, R/stat-binhex.R, R/stat-boxplot.R, R/stat-contour.R,
+% R/stat-count.R, R/stat-density-2d.R, R/stat-density.R, R/stat-ecdf.R,
+% R/stat-ellipse.R, R/stat-function.R, R/stat-identity.R, R/stat-qq-line.R,
+% R/stat-qq.R, R/stat-quantilemethods.R, R/stat-smooth.R, R/stat-sum.R,
+% R/stat-summary-2d.R, R/stat-summary-bin.R, R/stat-summary-hex.R,
+% R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R
\docType{data}
\name{ggplot2-ggproto}
\alias{ggplot2-ggproto}
@@ -93,6 +94,7 @@
\alias{GuideAxis}
\alias{GuideAxisLogticks}
\alias{GuideAxisStack}
+\alias{GuideAxisTheta}
\alias{GuideLegend}
\alias{GuideBins}
\alias{GuideColourbar}