From a96e6640214a99a9488d166353f94bf8939b52b2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 29 Nov 2023 17:39:47 +0100 Subject: [PATCH 01/22] Key background inherits panel background (#5551) * legend.key inherits from panel.background * default themes don't set legend.key * accept slightly darker keys in tests * Add news bullet * accept stray snapshot --- NEWS.md | 4 ++++ R/theme-defaults.R | 15 ++------------- R/theme-elements.R | 2 +- .../_snaps/guides/left-aligned-legend-key.svg | 6 +++--- .../theme/caption-aligned-to-entire-plot.svg | 6 +++--- .../testthat/_snaps/theme/theme-classic-large.svg | 2 ++ tests/testthat/_snaps/theme/theme-classic.svg | 2 ++ tests/testthat/_snaps/theme/theme-gray-large.svg | 4 ++-- tests/testthat/_snaps/theme/theme-gray.svg | 4 ++-- .../theme/titles-aligned-to-entire-plot.svg | 6 +++--- 10 files changed, 24 insertions(+), 27 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4596436f9a..1cbd49cf1d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* The `legend.key` theme element is set to inherit from the `panel.background` + theme element. The default themes no longer set the `legend.key` element. + This causes a visual change with the default `theme_gray()` (#5549). + * Lines where `linewidth = NA` are now dropped in `geom_sf()` (#5204). * New `guide_axis_logticks()` can be used to draw logarithmic tick marks as diff --git a/R/theme-defaults.R b/R/theme-defaults.R index da315e2e25..7a062409a0 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -172,7 +172,7 @@ theme_grey <- function(base_size = 11, base_family = "", legend.spacing.x = NULL, legend.spacing.y = NULL, legend.margin = margin(half_line, half_line, half_line, half_line), - legend.key = element_rect(fill = "grey95", colour = NA), + legend.key = NULL, legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, @@ -266,8 +266,6 @@ theme_bw <- function(base_size = 11, base_family = "", panel.grid.minor = element_line(linewidth = rel(0.5)), # contour strips to match panel contour strip.background = element_rect(fill = "grey85", colour = "grey20"), - # match legend key to background - legend.key = element_rect(fill = "white", colour = NA), complete = TRUE ) @@ -340,9 +338,6 @@ theme_light <- function(base_size = 11, base_family = "", # match axes ticks thickness to gridlines and colour to panel border axis.ticks = element_line(colour = "grey70", linewidth = rel(0.5)), - # match legend key to panel.background - legend.key = element_rect(fill = "white", colour = NA), - # dark strips with light text (inverse contrast compared to theme_grey) strip.background = element_rect(fill = "grey70", colour = NA), strip.text = element_text( @@ -382,9 +377,6 @@ theme_dark <- function(base_size = 11, base_family = "", # match axes ticks thickness to gridlines axis.ticks = element_line(colour = "grey20", linewidth = rel(0.5)), - # match legend key to panel.background - legend.key = element_rect(fill = "grey50", colour = NA), - # dark strips with light text (inverse contrast compared to theme_grey) strip.background = element_rect(fill = "grey15", colour = NA), strip.text = element_text( @@ -442,9 +434,6 @@ theme_classic <- function(base_size = 11, base_family = "", # show axes axis.line = element_line(colour = "black", linewidth = rel(1)), - # match legend key to panel.background - legend.key = element_blank(), - # simple, black and white strips strip.background = element_rect(fill = "white", colour = "black", linewidth = rel(2)), # NB: size is 1 but clipped, it looks like the 0.5 of the axes @@ -586,7 +575,7 @@ theme_test <- function(base_size = 11, base_family = "", legend.spacing.x = NULL, legend.spacing.y = NULL, legend.margin = margin(0, 0, 0, 0, "cm"), - legend.key = element_rect(fill = "white", colour=NA), + legend.key = NULL, legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, diff --git a/R/theme-elements.R b/R/theme-elements.R index 4dda819879..d671ec2900 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -497,7 +497,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.spacing = el_def("unit"), legend.spacing.x = el_def(c("unit", "rel"), "legend.spacing"), legend.spacing.y = el_def(c("unit", "rel"), "legend.spacing"), - legend.key = el_def("element_rect", "rect"), + legend.key = el_def("element_rect", "panel.background"), legend.key.height = el_def(c("unit", "rel"), "legend.key.size"), legend.key.width = el_def(c("unit", "rel"), "legend.key.size"), legend.text = el_def("element_text", "text"), diff --git a/tests/testthat/_snaps/guides/left-aligned-legend-key.svg b/tests/testthat/_snaps/guides/left-aligned-legend-key.svg index 386f9c2f08..e71689c336 100644 --- a/tests/testthat/_snaps/guides/left-aligned-legend-key.svg +++ b/tests/testthat/_snaps/guides/left-aligned-legend-key.svg @@ -105,11 +105,11 @@ disp mpg - + - + - + 4 6 diff --git a/tests/testthat/_snaps/theme/caption-aligned-to-entire-plot.svg b/tests/testthat/_snaps/theme/caption-aligned-to-entire-plot.svg index dbf642230b..e5d8b37a9b 100644 --- a/tests/testthat/_snaps/theme/caption-aligned-to-entire-plot.svg +++ b/tests/testthat/_snaps/theme/caption-aligned-to-entire-plot.svg @@ -183,11 +183,11 @@ y z - + - + - + a b diff --git a/tests/testthat/_snaps/theme/theme-classic-large.svg b/tests/testthat/_snaps/theme/theme-classic-large.svg index 4d0c2477ac..96767cc14f 100644 --- a/tests/testthat/_snaps/theme/theme-classic-large.svg +++ b/tests/testthat/_snaps/theme/theme-classic-large.svg @@ -69,7 +69,9 @@ y z + + a b diff --git a/tests/testthat/_snaps/theme/theme-classic.svg b/tests/testthat/_snaps/theme/theme-classic.svg index 41663236ff..8588be9819 100644 --- a/tests/testthat/_snaps/theme/theme-classic.svg +++ b/tests/testthat/_snaps/theme/theme-classic.svg @@ -69,7 +69,9 @@ y z + + a b diff --git a/tests/testthat/_snaps/theme/theme-gray-large.svg b/tests/testthat/_snaps/theme/theme-gray-large.svg index 971aeb4eef..a827864db6 100644 --- a/tests/testthat/_snaps/theme/theme-gray-large.svg +++ b/tests/testthat/_snaps/theme/theme-gray-large.svg @@ -85,9 +85,9 @@ y z - + - + a b diff --git a/tests/testthat/_snaps/theme/theme-gray.svg b/tests/testthat/_snaps/theme/theme-gray.svg index dad37dc2ff..cc01144439 100644 --- a/tests/testthat/_snaps/theme/theme-gray.svg +++ b/tests/testthat/_snaps/theme/theme-gray.svg @@ -85,9 +85,9 @@ y z - + - + a b diff --git a/tests/testthat/_snaps/theme/titles-aligned-to-entire-plot.svg b/tests/testthat/_snaps/theme/titles-aligned-to-entire-plot.svg index f4dc6068aa..ba0727fbd7 100644 --- a/tests/testthat/_snaps/theme/titles-aligned-to-entire-plot.svg +++ b/tests/testthat/_snaps/theme/titles-aligned-to-entire-plot.svg @@ -183,11 +183,11 @@ y z - + - + - + a b From f155d2fea958902e899daa3e06cd4b8b29df2f00 Mon Sep 17 00:00:00 2001 From: Elio Campitelli Date: Sun, 3 Dec 2023 18:20:26 -0300 Subject: [PATCH 02/22] Uses OutDec in isolines (#5556) * Uses OutDec in isolines * Updates news * Fix typo --- NEWS.md | 2 ++ R/stat-contour.R | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1cbd49cf1d..359d54ffb9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Contour functions will not fail when `options("OutDec")` is not `.` (@eliocamp, #5555). + * The `legend.key` theme element is set to inherit from the `panel.background` theme element. The default themes no longer set the `legend.key` element. This causes a visual change with the default `theme_gray()` (#5549). diff --git a/R/stat-contour.R b/R/stat-contour.R index a9249f69ff..9c08b639cf 100644 --- a/R/stat-contour.R +++ b/R/stat-contour.R @@ -107,7 +107,7 @@ StatContour <- ggproto("StatContour", Stat, breaks <- contour_breaks(z.range, bins, binwidth, breaks) - isolines <- xyz_to_isolines(data, breaks) + isolines <- withr::with_options(list(OutDec = "."), xyz_to_isolines(data, breaks)) path_df <- iso_to_path(isolines, data$group[1]) path_df$level <- as.numeric(path_df$level) @@ -140,7 +140,7 @@ StatContourFilled <- ggproto("StatContourFilled", Stat, compute_group = function(data, scales, z.range, bins = NULL, binwidth = NULL, breaks = NULL, na.rm = FALSE) { breaks <- contour_breaks(z.range, bins, binwidth, breaks) - isobands <- xyz_to_isobands(data, breaks) + isobands <- withr::with_options(list(OutDec = "."), xyz_to_isobands(data, breaks)) names(isobands) <- pretty_isoband_levels(names(isobands)) path_df <- iso_to_polygon(isobands, data$group[1]) From c00f875696ab0bff056e19c3692acaf39f90dda6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 4 Dec 2023 14:49:17 +0100 Subject: [PATCH 03/22] Use new {scales} syntax (#5544) * increment scales version * Use `transform_` prefixed version * rename palettes * reoxygenate --- DESCRIPTION | 2 +- R/axis-secondary.R | 2 +- R/coord-transform.R | 10 ++++----- R/guide-axis-logticks.R | 2 +- R/scale-.R | 16 ++++++------- R/scale-alpha.R | 8 +++---- R/scale-brewer.R | 20 ++++++++--------- R/scale-continuous.R | 16 ++++++------- R/scale-date.R | 10 ++++----- R/scale-expansion.R | 4 ++-- R/scale-gradient.R | 20 ++++++++--------- R/scale-grey.R | 6 ++--- R/scale-hue.R | 16 ++++++------- R/scale-identity.R | 18 +++++++-------- R/scale-linetype.R | 4 ++-- R/scale-linewidth.R | 8 +++---- R/scale-shape.R | 4 ++-- R/scale-size.R | 10 ++++----- R/scale-steps.R | 14 ++++++------ R/scale-viridis.R | 26 +++++++++++----------- R/utilities.R | 2 +- R/zxx.R | 14 ++++++------ icons/icons.R | 2 +- man/binned_scale.Rd | 8 +++---- man/continuous_scale.Rd | 8 +++---- man/coord_trans.Rd | 4 ++-- man/datetime_scale.Rd | 2 +- man/discrete_scale.Rd | 2 +- man/hmisc.Rd | 8 +++---- man/scale_binned.Rd | 6 ++--- man/scale_brewer.Rd | 2 +- man/scale_continuous.Rd | 10 ++++----- man/scale_discrete.Rd | 2 +- man/scale_gradient.Rd | 10 ++++----- man/scale_grey.Rd | 2 +- man/scale_hue.Rd | 2 +- man/scale_linetype.Rd | 2 +- man/scale_linewidth.Rd | 6 ++--- man/scale_manual.Rd | 2 +- man/scale_shape.Rd | 2 +- man/scale_size.Rd | 6 ++--- man/scale_steps.Rd | 8 +++---- man/scale_viridis.Rd | 18 +++++++-------- tests/testthat/test-coord-transform.R | 4 ++-- tests/testthat/test-guides.R | 18 +++++++-------- tests/testthat/test-scale-expansion.R | 6 ++--- tests/testthat/test-scale-hue.R | 6 ++--- tests/testthat/test-scales-breaks-labels.R | 8 +++---- tests/testthat/test-scales.R | 14 ++++++------ tests/testthat/test-sec-axis.R | 4 ++-- vignettes/extending-ggplot2.Rmd | 2 +- 51 files changed, 203 insertions(+), 203 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1b869d4bdf..3815343626 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,7 +40,7 @@ Imports: MASS, mgcv, rlang (>= 1.1.0), - scales (>= 1.2.0), + scales (>= 1.3.0), stats, tibble, vctrs (>= 0.5.0), diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 0edb9106fd..1d44fe967b 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -280,7 +280,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, }, # Temporary scale for the purpose of calling break_info() - create_scale = function(self, range, trans = identity_trans()) { + create_scale = function(self, range, trans = transform_identity()) { scale <- ggproto(NULL, ScaleContinuousPosition, name = self$name, breaks = self$breaks, diff --git a/R/coord-transform.R b/R/coord-transform.R index 5beaadf6d2..9fde8bb98e 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -5,7 +5,7 @@ #' no guarantee that straight lines will continue to be straight. #' #' Transformations only work with continuous values: see -#' [scales::trans_new()] for list of transformations, and instructions +#' [scales::new_transform()] for list of transformations, and instructions #' on how to create your own. #' #' @inheritParams coord_cartesian @@ -60,7 +60,7 @@ #' geom_smooth(method = "lm") + #' scale_x_log10() + #' scale_y_log10() + -#' coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) +#' coord_trans(x = scales::transform_exp(10), y = scales::transform_exp(10)) #' #' # cf. #' ggplot(diamonds, aes(carat, price)) + @@ -90,8 +90,8 @@ coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL check_coord_limits(ylim) # resolve transformers - if (is.character(x)) x <- as.trans(x) - if (is.character(y)) y <- as.trans(y) + if (is.character(x)) x <- as.transform(x) + if (is.character(y)) y <- as.transform(y) ggproto(NULL, CoordTrans, trans = list(x = x, y = y), @@ -190,7 +190,7 @@ transform_value <- function(trans, value, range) { # TODO: can we merge this with view_scales_from_scale()? view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) - scale_trans <- scale$trans %||% identity_trans() + scale_trans <- scale$trans %||% transform_identity() coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) scale_limits <- scale$get_limits() diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 5e97d3f193..699b52aee2 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -154,7 +154,7 @@ GuideAxisLogticks <- ggproto( "{.field {trans_name}} transformation in log-tick positioning." )) } - trans <- log_trans(base = params$prescale_base) + trans <- transform_log(base = params$prescale_base) } else { trans <- scale$scale$trans } diff --git a/R/scale-.R b/R/scale-.R index eb4248048d..f49fb8e2c7 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -7,7 +7,7 @@ #' that should be used for error messages associated with this scale. #' @param palette A palette function that when called with a numeric vector with #' values between 0 and 1 returns the corresponding output values -#' (e.g., [scales::area_pal()]). +#' (e.g., [scales::pal_area()]). #' @param name The name of the scale. Used as the axis or legend title. If #' `waiver()`, the default, the name of the scale is taken from the first #' mapping used for that aesthetic. If `NULL`, the legend title will be @@ -15,7 +15,7 @@ #' @param breaks One of: #' - `NULL` for no breaks #' - `waiver()` for the default breaks computed by the -#' [transformation object][scales::trans_new()] +#' [transformation object][scales::new_transform()] #' - A numeric vector of positions #' - A function that takes the limits as input and returns breaks #' as output (e.g., a function returned by [scales::extended_breaks()]). @@ -75,8 +75,8 @@ #' and methods for generating breaks and labels. Transformation objects #' are defined in the scales package, and are called `_trans`. If #' transformations require arguments, you can call them from the scales -#' package, e.g. [`scales::boxcox_trans(p = 2)`][scales::boxcox_trans]. -#' You can create your own transformation with [scales::trans_new()]. +#' package, e.g. [`scales::transform_boxcox(p = 2)`][scales::transform_boxcox]. +#' You can create your own transformation with [scales::new_transform()]. #' @param guide A function used to create a guide or its name. See #' [guides()] for more information. #' @param expand For position scales, a vector of range expansion constants used to add some @@ -113,7 +113,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam guide <- "none" } - trans <- as.trans(trans) + trans <- as.transform(trans) if (!is.null(limits) && !is.function(limits)) { limits <- trans$transform(limits) } @@ -157,7 +157,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam #' @inheritParams continuous_scale #' @param palette A palette function that when called with a single integer #' argument (the number of levels in the scale) returns the values that -#' they should take (e.g., [scales::hue_pal()]). +#' they should take (e.g., [scales::pal_hue()]). #' @param breaks One of: #' - `NULL` for no breaks #' - `waiver()` for the default breaks (the scale limits) @@ -278,7 +278,7 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = guide <- "none" } - trans <- as.trans(trans) + trans <- as.transform(trans) if (!is.null(limits)) { limits <- trans$transform(limits) } @@ -603,7 +603,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, oob = censor, minor_breaks = waiver(), n.breaks = NULL, - trans = identity_trans(), + trans = transform_identity(), is_discrete = function() FALSE, diff --git a/R/scale-alpha.R b/R/scale-alpha.R index 8be2925c58..9271bd0b5b 100644 --- a/R/scale-alpha.R +++ b/R/scale-alpha.R @@ -24,7 +24,7 @@ #' 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 = rescale_pal(range), ...) + continuous_scale("alpha", palette = pal_rescale(range), ...) } #' @rdname scale_alpha @@ -34,7 +34,7 @@ scale_alpha_continuous <- scale_alpha #' @rdname scale_alpha #' @export scale_alpha_binned <- function(..., range = c(0.1, 1)) { - binned_scale("alpha", palette = rescale_pal(range), ...) + binned_scale("alpha", palette = pal_rescale(range), ...) } #' @rdname scale_alpha @@ -60,12 +60,12 @@ scale_alpha_ordinal <- function(..., range = c(0.1, 1)) { #' @export #' @usage NULL scale_alpha_datetime <- function(..., range = c(0.1, 1)) { - datetime_scale("alpha", "time", palette = rescale_pal(range), ...) + datetime_scale("alpha", "time", palette = pal_rescale(range), ...) } #' @rdname scale_alpha #' @export #' @usage NULL scale_alpha_date <- function(..., range = c(0.1, 1)){ - datetime_scale("alpha", "date", palette = rescale_pal(range), ...) + datetime_scale("alpha", "date", palette = pal_rescale(range), ...) } diff --git a/R/scale-brewer.R b/R/scale-brewer.R index 6ecc12ba95..f01daff81c 100644 --- a/R/scale-brewer.R +++ b/R/scale-brewer.R @@ -8,7 +8,7 @@ #' #' @note #' The `distiller` scales extend `brewer` scales by smoothly -#' interpolating 7 colours from any palette to a continuous scale. +#' interpolating 7 colours from any palette to a continuous scale. #' The `distiller` scales have a default direction = -1. To reverse, use direction = 1. #' The `fermenter` scales provide binned versions of the `brewer` scales. #' @@ -27,10 +27,10 @@ #' } #' Modify the palette through the `palette` argument. #' -#' @inheritParams scales::brewer_pal +#' @inheritParams scales::pal_brewer #' @inheritParams scale_colour_hue #' @inheritParams scale_colour_gradient -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_gradient_n #' @param palette If a string, will use that named palette. If a number, will index into #' the list of palettes of appropriate `type`. The list of available palettes can found #' in the Palettes section. @@ -52,7 +52,7 @@ #' # Change scale label #' d + scale_colour_brewer("Diamond\nclarity") #' -#' # Select brewer palette to use, see ?scales::brewer_pal for more details +#' # Select brewer palette to use, see ?scales::pal_brewer for more details #' d + scale_colour_brewer(palette = "Greens") #' d + scale_colour_brewer(palette = "Set1") #' @@ -84,13 +84,13 @@ #' v + scale_fill_fermenter() #' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { - discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, 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 = brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, palette = pal_brewer(type, palette, direction), ...) } #' @export @@ -106,7 +106,7 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = - } continuous_scale( aesthetics, - palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ... ) # NB: 6-7 colours per palette gives nice gradients; more results in more saturated colours which do not look as good @@ -125,7 +125,7 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, } continuous_scale( aesthetics, - palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + palette = pal_gradient_n(pal_brewer(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ... ) } @@ -141,7 +141,7 @@ scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = - "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...) } #' @export @@ -154,5 +154,5 @@ 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 = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = pal_binned(pal_brewer(type, palette, direction)), na.value = na.value, guide = guide, ...) } diff --git a/R/scale-continuous.R b/R/scale-continuous.R index 265364e778..002e03316a 100644 --- a/R/scale-continuous.R +++ b/R/scale-continuous.R @@ -64,9 +64,9 @@ #' p1 + scale_y_reverse() #' #' # Or you can supply a transformation in the `trans` argument: -#' p1 + scale_y_continuous(trans = scales::reciprocal_trans()) +#' p1 + scale_y_continuous(trans = scales::transform_reciprocal()) #' -#' # You can also create your own. See ?scales::trans_new +#' # You can also create your own. See ?scales::new_transform #' #' @name scale_continuous #' @aliases NULL @@ -169,30 +169,30 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous, #' @rdname scale_continuous #' @export scale_x_log10 <- function(...) { - scale_x_continuous(..., trans = log10_trans()) + scale_x_continuous(..., trans = transform_log10()) } #' @rdname scale_continuous #' @export scale_y_log10 <- function(...) { - scale_y_continuous(..., trans = log10_trans()) + scale_y_continuous(..., trans = transform_log10()) } #' @rdname scale_continuous #' @export scale_x_reverse <- function(...) { - scale_x_continuous(..., trans = reverse_trans()) + scale_x_continuous(..., trans = transform_reverse()) } #' @rdname scale_continuous #' @export scale_y_reverse <- function(...) { - scale_y_continuous(..., trans = reverse_trans()) + scale_y_continuous(..., trans = transform_reverse()) } #' @rdname scale_continuous #' @export scale_x_sqrt <- function(...) { - scale_x_continuous(..., trans = sqrt_trans()) + scale_x_continuous(..., trans = transform_sqrt()) } #' @rdname scale_continuous #' @export scale_y_sqrt <- function(...) { - scale_y_continuous(..., trans = sqrt_trans()) + scale_y_continuous(..., trans = transform_sqrt()) } diff --git a/R/scale-date.R b/R/scale-date.R index 3824d232a1..6dfc419a1a 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -242,7 +242,7 @@ scale_x_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::hms_trans(), + trans = scales::transform_hms(), sec.axis = sec.axis ) } @@ -273,7 +273,7 @@ scale_y_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::hms_trans(), + trans = scales::transform_hms(), sec.axis = sec.axis ) } @@ -326,8 +326,8 @@ datetime_scale <- function(aesthetics, trans, palette, } trans <- switch(trans, - date = date_trans(), - time = time_trans(timezone) + date = transform_date(), + time = transform_time(timezone) ) sc <- continuous_scale( @@ -357,7 +357,7 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous, tz <- attr(x, "tzone") if (is.null(self$timezone) && !is.null(tz)) { self$timezone <- tz - self$trans <- time_trans(self$timezone) + self$trans <- transform_time(self$timezone) } ggproto_parent(ScaleContinuous, self)$transform(x) }, diff --git a/R/scale-expansion.R b/R/scale-expansion.R index dd31ac3275..abba246226 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -168,7 +168,7 @@ expand_limits_discrete <- function(limits, expand = expansion(0, 0), coord_limit } expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), - coord_limits = c(NA, NA), trans = identity_trans()) { + coord_limits = c(NA, NA), trans = transform_identity()) { # let non-NA coord_limits override the scale limits limits <- ifelse(is.na(coord_limits), limits, coord_limits) @@ -198,7 +198,7 @@ expand_limits_continuous_trans <- function(limits, expand = expansion(0, 0), } expand_limits_discrete_trans <- function(limits, expand = expansion(0, 0), - coord_limits = c(NA, NA), trans = identity_trans(), + coord_limits = c(NA, NA), trans = transform_identity(), range_continuous = NULL) { if (is.discrete(limits)) { n_discrete_limits <- length(limits) diff --git a/R/scale-gradient.R b/R/scale-gradient.R index 95ee2824b2..16461e2ca4 100644 --- a/R/scale-gradient.R +++ b/R/scale-gradient.R @@ -11,13 +11,13 @@ #' luminance. The \pkg{munsell} package makes this easy to do using the #' Munsell colour system. #' -#' @inheritParams scales::seq_gradient_pal +#' @inheritParams scales::pal_seq_gradient #' @inheritParams scale_colour_hue #' @param low,high Colours for low and high ends of the gradient. #' @param guide Type of legend. Use `"colourbar"` for continuous #' colour bar, or `"legend"` for discrete colour legend. #' @inheritDotParams continuous_scale -na.value -guide -aesthetics -#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' @seealso [scales::pal_seq_gradient()] for details on underlying #' palette, [scale_colour_steps()] for binned variants of these scales. #' #' The documentation on [colour aesthetics][aes_colour_fill_alpha]. @@ -77,7 +77,7 @@ #' scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") { - continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } @@ -85,11 +85,11 @@ scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space #' @export scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") { - continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } -#' @inheritParams scales::div_gradient_pal +#' @inheritParams scales::pal_div_gradient #' @param midpoint The midpoint (in data value) of the diverging scale. #' Defaults to 0. #' @rdname scale_gradient @@ -99,7 +99,7 @@ scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high aesthetics = "colour") { continuous_scale( aesthetics, - palette = div_gradient_pal(low, mid, high, space), + palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, ..., rescaler = mid_rescaler(mid = midpoint) ) @@ -112,7 +112,7 @@ scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = aesthetics = "fill") { continuous_scale( aesthetics, - palette = div_gradient_pal(low, mid, high, space), + palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, ..., rescaler = mid_rescaler(mid = midpoint) ) @@ -124,7 +124,7 @@ mid_rescaler <- function(mid) { } } -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_gradient_n #' @param colours,colors Vector of colours to use for n-colour gradient. #' @rdname scale_gradient #' @export @@ -134,7 +134,7 @@ scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", n continuous_scale( aesthetics, - palette = gradient_n_pal(colours, values, space), + palette = pal_gradient_n(colours, values, space), na.value = na.value, guide = guide, ... ) } @@ -146,7 +146,7 @@ scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na. continuous_scale( aesthetics, - palette = gradient_n_pal(colours, values, space), + 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 c71dd444ef..d32437606f 100644 --- a/R/scale-grey.R +++ b/R/scale-grey.R @@ -3,7 +3,7 @@ #' Based on [gray.colors()]. This is black and white equivalent #' of [scale_colour_gradient()]. #' -#' @inheritParams scales::grey_pal +#' @inheritParams scales::pal_grey #' @inheritParams scale_colour_hue #' @inheritDotParams discrete_scale #' @family colour scales @@ -28,13 +28,13 @@ #' 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 = grey_pal(start, end), + discrete_scale(aesthetics, 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 = grey_pal(start, end), + discrete_scale(aesthetics, palette = pal_grey(start, end), na.value = na.value, ...) } diff --git a/R/scale-hue.R b/R/scale-hue.R index 0e0d796537..fe8545dc76 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -9,7 +9,7 @@ #' name(s) of the aesthetic(s) that this scale works with. This can be useful, for #' example, to apply colour settings to the `colour` and `fill` aesthetics at the #' same time, via `aesthetics = c("colour", "fill")`. -#' @inheritParams scales::hue_pal +#' @inheritParams scales::pal_hue #' @rdname scale_hue #' @export #' @family colour scales @@ -55,7 +55,7 @@ #' } 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 = hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = pal_hue(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -63,7 +63,7 @@ scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = #' @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 = hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = pal_hue(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -168,7 +168,7 @@ 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") { discrete_scale( - aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction), na.value = na.value, ... ) } @@ -176,7 +176,7 @@ scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 1 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") { discrete_scale( - aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = pal_qualitative(type, h, c, l, h.start, direction), na.value = na.value, ... ) } @@ -184,16 +184,16 @@ scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100 #' Given set(s) of colour codes (i.e., type), find the smallest set that can support n levels #' @param type a character vector or a list of character vectors #' @noRd -qualitative_pal <- function(type, h, c, l, h.start, direction) { +pal_qualitative <- function(type, h, c, l, h.start, direction) { function(n) { type_list <- if (!is.list(type)) list(type) else type if (!all(vapply(type_list, is.character, logical(1)))) { cli::cli_abort("{.arg type} must be a character vector or a list of character vectors") } type_lengths <- lengths(type_list) - # If there are more levels than color codes default to hue_pal() + # If there are more levels than color codes default to pal_hue() if (max(type_lengths) < n) { - return(scales::hue_pal(h, c, l, h.start, direction)(n)) + return(scales::pal_hue(h, c, l, h.start, direction)(n)) } # Use the minimum length vector that exceeds the number of levels (n) type_list <- type_list[order(type_lengths)] diff --git a/R/scale-identity.R b/R/scale-identity.R index 9a3ace41a0..b070d04c4b 100644 --- a/R/scale-identity.R +++ b/R/scale-identity.R @@ -63,7 +63,7 @@ NULL #' @rdname scale_identity #' @export scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -72,7 +72,7 @@ scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { #' @rdname scale_identity #' @export scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -83,7 +83,7 @@ scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { #' Other shape scales: [scale_shape()], [scale_shape_manual()]. #' @export scale_shape_identity <- function(..., guide = "none") { - sc <- continuous_scale("shape", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("shape", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -94,7 +94,7 @@ scale_shape_identity <- function(..., guide = "none") { #' Other linetype scales: [scale_linetype()], [scale_linetype_manual()]. #' @export scale_linetype_identity <- function(..., guide = "none") { - sc <- discrete_scale("linetype", palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale("linetype", palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -105,7 +105,7 @@ scale_linetype_identity <- function(..., guide = "none") { #' Other alpha scales: [scale_alpha()], [scale_alpha_manual()]. #' @export scale_linewidth_identity <- function(..., guide = "none") { - sc <- continuous_scale("linewidth", palette = identity_pal(), ..., + sc <- continuous_scale("linewidth", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -114,7 +114,7 @@ scale_linewidth_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_alpha_identity <- function(..., guide = "none") { - sc <- continuous_scale("alpha", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("alpha", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -125,7 +125,7 @@ scale_alpha_identity <- function(..., guide = "none") { #' Other size scales: [scale_size()], [scale_size_manual()]. #' @export scale_size_identity <- function(..., guide = "none") { - sc <- continuous_scale("size", palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale("size", palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -134,7 +134,7 @@ scale_size_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_discrete_identity <- function(aesthetics, ..., guide = "none") { - sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -143,7 +143,7 @@ scale_discrete_identity <- function(aesthetics, ..., guide = "none") { #' @rdname scale_identity #' @export scale_continuous_identity <- function(aesthetics, ..., guide = "none") { - sc <- continuous_scale(aesthetics, palette = identity_pal(), ..., guide = guide, + sc <- continuous_scale(aesthetics, palette = pal_identity(), ..., guide = guide, super = ScaleContinuousIdentity) sc diff --git a/R/scale-linetype.R b/R/scale-linetype.R index 494abc5d55..d3bc3b6e87 100644 --- a/R/scale-linetype.R +++ b/R/scale-linetype.R @@ -34,14 +34,14 @@ #' facet_grid(linetype ~ .) + #' theme_void(20) scale_linetype <- function(..., na.value = "blank") { - discrete_scale("linetype", palette = linetype_pal(), + discrete_scale("linetype", palette = pal_linetype(), na.value = na.value, ...) } #' @rdname scale_linetype #' @export scale_linetype_binned <- function(..., na.value = "blank") { - binned_scale("linetype", palette = binned_pal(linetype_pal()), ...) + binned_scale("linetype", palette = pal_binned(pal_linetype()), ...) } #' @rdname scale_linetype diff --git a/R/scale-linewidth.R b/R/scale-linewidth.R index 61f4dc1c0c..71c87b199c 100644 --- a/R/scale-linewidth.R +++ b/R/scale-linewidth.R @@ -31,7 +31,7 @@ scale_linewidth_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("linewidth", palette = rescale_pal(range), name = name, + continuous_scale("linewidth", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -45,7 +45,7 @@ scale_linewidth <- scale_linewidth_continuous scale_linewidth_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, trans = "identity", guide = "bins") { - binned_scale("linewidth", palette = rescale_pal(range), name = name, + binned_scale("linewidth", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -77,12 +77,12 @@ scale_linewidth_ordinal <- function(..., range = c(2, 6)) { #' @export #' @usage NULL scale_linewidth_datetime <- function(..., range = c(1, 6)) { - datetime_scale("linewidth", "time", palette = rescale_pal(range), ...) + datetime_scale("linewidth", "time", palette = pal_rescale(range), ...) } #' @rdname scale_linewidth #' @export #' @usage NULL scale_linewidth_date <- function(..., range = c(1, 6)) { - datetime_scale("linewidth", "date", palette = rescale_pal(range), ...) + datetime_scale("linewidth", "date", palette = pal_rescale(range), ...) } diff --git a/R/scale-shape.R b/R/scale-shape.R index cc293174ef..8d3ef30ef1 100644 --- a/R/scale-shape.R +++ b/R/scale-shape.R @@ -41,13 +41,13 @@ #' facet_wrap(~shape) + #' theme_void() scale_shape <- function(..., solid = TRUE) { - discrete_scale("shape", palette = shape_pal(solid), ...) + discrete_scale("shape", palette = pal_shape(solid), ...) } #' @rdname scale_shape #' @export scale_shape_binned <- function(..., solid = TRUE) { - binned_scale("shape", palette = binned_pal(shape_pal(solid)), ...) + binned_scale("shape", palette = pal_binned(pal_shape(solid)), ...) } #' @rdname scale_shape diff --git a/R/scale-size.R b/R/scale-size.R index c75a22fa3e..07fd89f442 100644 --- a/R/scale-size.R +++ b/R/scale-size.R @@ -52,7 +52,7 @@ NULL scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", palette = area_pal(range), name = name, + continuous_scale("size", palette = pal_area(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -66,7 +66,7 @@ scale_size <- scale_size_continuous scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", palette = rescale_pal(range), name = name, + continuous_scale("size", palette = pal_rescale(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -76,7 +76,7 @@ scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, trans = "identity", guide = "bins") { - binned_scale("size", palette = area_pal(range), name = name, + binned_scale("size", palette = pal_area(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -129,12 +129,12 @@ scale_size_binned_area <- function(..., max_size = 6) { #' @export #' @usage NULL scale_size_datetime <- function(..., range = c(1, 6)) { - datetime_scale("size", "time", palette = area_pal(range), ...) + datetime_scale("size", "time", palette = pal_area(range), ...) } #' @rdname scale_size #' @export #' @usage NULL scale_size_date <- function(..., range = c(1, 6)) { - datetime_scale("size", "date", palette = area_pal(range), ...) + datetime_scale("size", "date", palette = pal_area(range), ...) } diff --git a/R/scale-steps.R b/R/scale-steps.R index 5bbba07cb9..b5a1b2fb37 100644 --- a/R/scale-steps.R +++ b/R/scale-steps.R @@ -15,7 +15,7 @@ #' @inheritParams scale_colour_gradient #' @inheritDotParams binned_scale -aesthetics -scale_name -palette -na.value -guide -rescaler #' -#' @seealso [scales::seq_gradient_pal()] for details on underlying +#' @seealso [scales::pal_seq_gradient()] for details on underlying #' palette, [scale_colour_gradient()] for continuous scales without binning. #' #' The documentation on [colour aesthetics][aes_colour_fill_alpha]. @@ -46,7 +46,7 @@ #' @rdname scale_steps scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, palette = seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -54,7 +54,7 @@ scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = " scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -62,14 +62,14 @@ scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = m scale_colour_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour", colors) { colours <- if (missing(colours)) colors else colours - binned_scale(aesthetics, palette = gradient_n_pal(colours, values, space), + binned_scale(aesthetics, 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 = seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -77,7 +77,7 @@ scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "La scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { - binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -85,6 +85,6 @@ scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = mut scale_fill_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "fill", colors) { colours <- if (missing(colours)) colors else colours - binned_scale(aesthetics, palette = gradient_n_pal(colours, values, space), + binned_scale(aesthetics, 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 72ecd4a491..4647d8f1e7 100644 --- a/R/scale-viridis.R +++ b/R/scale-viridis.R @@ -5,8 +5,8 @@ #' with common forms of colour blindness. See also #' . #' -#' @inheritParams scales::viridis_pal -#' @inheritParams scales::gradient_n_pal +#' @inheritParams scales::pal_viridis +#' @inheritParams scales::pal_gradient_n #' @inheritParams continuous_scale #' @param ... Other arguments passed on to [discrete_scale()], #' [continuous_scale()], or [binned_scale()] to control name, limits, breaks, @@ -37,7 +37,7 @@ #' # Change scale label #' d + scale_colour_viridis_d("City\nCenter") #' -#' # Select palette to use, see ?scales::viridis_pal for more details +#' # Select palette to use, see ?scales::pal_viridis for more details #' d + scale_colour_viridis_d(option = "plasma") #' d + scale_colour_viridis_d(option = "inferno") #' @@ -62,7 +62,7 @@ scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "colour") { discrete_scale( aesthetics, - palette = viridis_pal(alpha, begin, end, direction, option), + palette = pal_viridis(alpha, begin, end, direction, option), ... ) } @@ -73,7 +73,7 @@ scale_fill_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "fill") { discrete_scale( aesthetics, - palette = viridis_pal(alpha, begin, end, direction, option), + palette = pal_viridis(alpha, begin, end, direction, option), ... ) } @@ -86,8 +86,8 @@ scale_colour_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "colour") { continuous_scale( aesthetics, - palette = gradient_n_pal( - viridis_pal(alpha, begin, end, direction, option)(6), + palette = pal_gradient_n( + pal_viridis(alpha, begin, end, direction, option)(6), values, space ), @@ -105,8 +105,8 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "fill") { continuous_scale( aesthetics, - palette = gradient_n_pal( - viridis_pal(alpha, begin, end, direction, option)(6), + palette = pal_gradient_n( + pal_viridis(alpha, begin, end, direction, option)(6), values, space ), @@ -122,8 +122,8 @@ 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") { - pal <- binned_pal( - viridis_pal(alpha, begin, end, direction, option) + pal <- pal_binned( + pal_viridis(alpha, begin, end, direction, option) ) binned_scale( @@ -141,8 +141,8 @@ 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") { - pal <- binned_pal( - viridis_pal(alpha, begin, end, direction, option) + pal <- pal_binned( + pal_viridis(alpha, begin, end, direction, option) ) binned_scale( diff --git a/R/utilities.R b/R/utilities.R index 1efbc121ff..ad831790d3 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -178,7 +178,7 @@ rescale01 <- function(x) { (x - rng[1]) / (rng[2] - rng[1]) } -binned_pal <- function(palette) { +pal_binned <- function(palette) { function(x) { palette(length(x)) } diff --git a/R/zxx.R b/R/zxx.R index 369f7c532c..080bdfceb2 100644 --- a/R/zxx.R +++ b/R/zxx.R @@ -16,7 +16,7 @@ scale_colour_ordinal <- function(..., type = getOption("ggplot2.ordinal.colour", exec( discrete_scale, aesthetics = "colour", - palette = ordinal_pal(type), + palette = pal_ordinal(type), !!!args ) } @@ -40,7 +40,7 @@ scale_colour_datetime <- function(..., datetime_scale( "colour", "time", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -64,7 +64,7 @@ scale_colour_date <- function(..., datetime_scale( "colour", "date", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -94,13 +94,13 @@ scale_fill_ordinal <- function(..., type = getOption("ggplot2.ordinal.fill", get exec( discrete_scale, aesthetics = "fill", - palette = ordinal_pal(type), + palette = pal_ordinal(type), !!!args ) } } -ordinal_pal <- function(colours, na.color = "grey50", alpha = TRUE) { +pal_ordinal <- function(colours, na.color = "grey50", alpha = TRUE) { pal <- scales::colour_ramp(colours, na.color = na.color, alpha = alpha) function(n) { pal(seq(0, 1, length.out = n)) @@ -119,7 +119,7 @@ scale_fill_datetime <- function(..., datetime_scale( "fill", "time", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... @@ -138,7 +138,7 @@ scale_fill_date <- function(..., datetime_scale( "fill", "date", - palette = seq_gradient_pal(low, high, space), + palette = pal_seq_gradient(low, high, space), na.value = na.value, guide = guide, ... diff --git a/icons/icons.R b/icons/icons.R index 23464aa818..36ed8bfa8d 100644 --- a/icons/icons.R +++ b/icons/icons.R @@ -139,7 +139,7 @@ write_icon("geom_bin2d", { out <- expand.grid(x = x, y = x) fill <- sqrt((out$x - 0.5) ^ 2 + (out$y - 0.5) ^ 2) - pal <- scales::seq_gradient_pal("#56B1F7", "#132B43") + pal <- scales::pal_seq_gradient("#56B1F7", "#132B43") rectGrob( out$x + 1/n/2, out$y + 1/n/2, diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index e242ee7a6b..31d70663f0 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -35,7 +35,7 @@ that should be used for error messages associated with this scale.} \item{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:area_pal]{scales::area_pal()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \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 @@ -46,7 +46,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -130,8 +130,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{show.limits}{should the limits of the scale appear as ticks} diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 530d96e525..407916b251 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -33,7 +33,7 @@ that should be used for error messages associated with this scale.} \item{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:area_pal]{scales::area_pal()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \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 @@ -44,7 +44,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -128,8 +128,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/coord_trans.Rd b/man/coord_trans.Rd index 46574c61f6..c1b6285b10 100644 --- a/man/coord_trans.Rd +++ b/man/coord_trans.Rd @@ -42,7 +42,7 @@ no guarantee that straight lines will continue to be straight. } \details{ Transformations only work with continuous values: see -\code{\link[scales:trans_new]{scales::trans_new()}} for list of transformations, and instructions +\code{\link[scales:new_transform]{scales::new_transform()}} for list of transformations, and instructions on how to create your own. } \examples{ @@ -93,7 +93,7 @@ ggplot(diamonds, aes(carat, price)) + geom_smooth(method = "lm") + scale_x_log10() + scale_y_log10() + - coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10)) + coord_trans(x = scales::transform_exp(10), y = scales::transform_exp(10)) # cf. ggplot(diamonds, aes(carat, price)) + diff --git a/man/datetime_scale.Rd b/man/datetime_scale.Rd index c3a2f778a1..117d04b013 100644 --- a/man/datetime_scale.Rd +++ b/man/datetime_scale.Rd @@ -28,7 +28,7 @@ the object itself. Built-in transformations include "hms", "date" and "time".} \item{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:area_pal]{scales::area_pal()}}).} +(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \item{breaks}{One of: \itemize{ diff --git a/man/discrete_scale.Rd b/man/discrete_scale.Rd index b2047dcbde..09989073e0 100644 --- a/man/discrete_scale.Rd +++ b/man/discrete_scale.Rd @@ -30,7 +30,7 @@ that should be used for error messages associated with this scale.} \item{palette}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \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 diff --git a/man/hmisc.Rd b/man/hmisc.Rd index 40fe36ca41..96fd7bba30 100644 --- a/man/hmisc.Rd +++ b/man/hmisc.Rd @@ -29,10 +29,10 @@ These are wrappers around functions from \pkg{Hmisc} designed to make them easier to use with \code{\link[=stat_summary]{stat_summary()}}. See the Hmisc documentation for more details: \itemize{ -\item \code{\link[Hmisc:smean.cl.boot]{Hmisc::smean.cl.boot()}} -\item \code{\link[Hmisc:smean.cl.normal]{Hmisc::smean.cl.normal()}} -\item \code{\link[Hmisc:smean.sdl]{Hmisc::smean.sdl()}} -\item \code{\link[Hmisc:smedian.hilow]{Hmisc::smedian.hilow()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.cl.boot()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.cl.normal()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smean.sdl()}} +\item \code{\link[Hmisc:smean.sd]{Hmisc::smedian.hilow()}} } } \examples{ diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 7949c45f13..0046d8fbcd 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -58,7 +58,7 @@ breaks are given explicitly.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -128,8 +128,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_brewer.Rd b/man/scale_brewer.Rd index 428aef60b5..d63941e0b3 100644 --- a/man/scale_brewer.Rd +++ b/man/scale_brewer.Rd @@ -145,7 +145,7 @@ d + scale_colour_brewer() # Change scale label d + scale_colour_brewer("Diamond\nclarity") -# Select brewer palette to use, see ?scales::brewer_pal for more details +# Select brewer palette to use, see ?scales::pal_brewer for more details d + scale_colour_brewer(palette = "Greens") d + scale_colour_brewer(palette = "Set1") diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index 1d376ef051..ec91afc919 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -65,7 +65,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -142,8 +142,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} @@ -215,9 +215,9 @@ p1 + scale_y_sqrt() p1 + scale_y_reverse() # Or you can supply a transformation in the `trans` argument: -p1 + scale_y_continuous(trans = scales::reciprocal_trans()) +p1 + scale_y_continuous(trans = scales::transform_reciprocal()) -# You can also create your own. See ?scales::trans_new +# You can also create your own. See ?scales::new_transform } \seealso{ diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index af686fe8a8..0333e4b60a 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -15,7 +15,7 @@ scale_y_discrete(..., expand = waiver(), guide = waiver(), position = "left") \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 35d57f2b68..cea9e781f9 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -92,7 +92,7 @@ scale_fill_gradientn( 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:area_pal]{scales::area_pal()}}).} +(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 @@ -101,7 +101,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -169,8 +169,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{\code{expand}}{For position scales, a vector of range expansion constants used to add some padding around the data to ensure that they are placed some distance away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} @@ -276,7 +276,7 @@ ggplot(df_na, aes(x = value, y)) + } \seealso{ -\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +\code{\link[scales:pal_seq_gradient]{scales::pal_seq_gradient()}} for details on underlying palette, \code{\link[=scale_colour_steps]{scale_colour_steps()}} for binned variants of these scales. The documentation on \link[=aes_colour_fill_alpha]{colour aesthetics}. diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index b25989858c..16cbf37e69 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -28,7 +28,7 @@ scale_fill_grey( \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd index 73c1fe0ade..480f8434af 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -34,7 +34,7 @@ scale_fill_hue( \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index 961064ea4d..21f079255c 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -21,7 +21,7 @@ scale_linetype_discrete(..., na.value = "blank") \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_linewidth.Rd b/man/scale_linewidth.Rd index 153ac04fdf..e699c24441 100644 --- a/man/scale_linewidth.Rd +++ b/man/scale_linewidth.Rd @@ -42,7 +42,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -87,8 +87,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_manual.Rd b/man/scale_manual.Rd index 7a3f7402cf..f39e9db7fc 100644 --- a/man/scale_manual.Rd +++ b/man/scale_manual.Rd @@ -46,7 +46,7 @@ scale_discrete_manual(aesthetics, ..., values, breaks = waiver()) \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{limits}}{One of: \itemize{ \item \code{NULL} to use the default scale values diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index 367aef2238..045c726e46 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -18,7 +18,7 @@ scale_shape_binned(..., solid = TRUE) \describe{ \item{\code{palette}}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that -they should take (e.g., \code{\link[scales:hue_pal]{scales::hue_pal()}}).} +they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_size.Rd b/man/scale_size.Rd index ac7d79021f..408493113f 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -59,7 +59,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -104,8 +104,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd index 4ce18b6839..a7906d8c4a 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -103,7 +103,7 @@ omitted.} \itemize{ \item \code{NULL} for no breaks \item \code{waiver()} for the default breaks computed by the -\link[scales:trans_new]{transformation object} +\link[scales:new_transform]{transformation object} \item A numeric vector of positions \item A function that takes the limits as input and returns breaks as output (e.g., a function returned by \code{\link[scales:breaks_extended]{scales::extended_breaks()}}). @@ -152,8 +152,8 @@ A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects are defined in the scales package, and are called \verb{_trans}. If transformations require arguments, you can call them from the scales -package, e.g. \code{\link[scales:boxcox_trans]{scales::boxcox_trans(p = 2)}}. -You can create your own transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} \item{\code{expand}}{For position scales, a vector of range expansion constants used to add some padding around the data to ensure that they are placed some distance away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} @@ -231,7 +231,7 @@ ggplot(df, aes(x, y)) + scale_colour_stepsn(colours = terrain.colors(10)) } \seealso{ -\code{\link[scales:seq_gradient_pal]{scales::seq_gradient_pal()}} for details on underlying +\code{\link[scales:pal_seq_gradient]{scales::pal_seq_gradient()}} for details on underlying palette, \code{\link[=scale_colour_gradient]{scale_colour_gradient()}} for continuous scales without binning. The documentation on \link[=aes_colour_fill_alpha]{colour aesthetics}. diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd index 4550146e7e..aaa029c763 100644 --- a/man/scale_viridis.Rd +++ b/man/scale_viridis.Rd @@ -109,14 +109,14 @@ reversed.} \item{option}{A character string indicating the color map option to use. Eight options are available: \itemize{ - \item "magma" (or "A") - \item "inferno" (or "B") - \item "plasma" (or "C") - \item "viridis" (or "D") - \item "cividis" (or "E") - \item "rocket" (or "F") - \item "mako" (or "G") - \item "turbo" (or "H") +\item \code{"magma"} (or \code{"A"}) +\item \code{"inferno"} (or \code{"B"}) +\item \code{"plasma"} (or \code{"C"}) +\item \code{"viridis"} (or \code{"D"}) +\item \code{"cividis"} (or \code{"E"}) +\item \code{"rocket"} (or \code{"F"}) +\item \code{"mako"} (or \code{"G"}) +\item \code{"turbo"} (or \code{"H"}) }} \item{aesthetics}{Character string or vector of character strings listing the @@ -160,7 +160,7 @@ d + scale_colour_viridis_d() # Change scale label d + scale_colour_viridis_d("City\nCenter") -# Select palette to use, see ?scales::viridis_pal for more details +# Select palette to use, see ?scales::pal_viridis for more details d + scale_colour_viridis_d(option = "plasma") d + scale_colour_viridis_d(option = "inferno") diff --git a/tests/testthat/test-coord-transform.R b/tests/testthat/test-coord-transform.R index 559ea74e88..1f58bdd5fe 100644 --- a/tests/testthat/test-coord-transform.R +++ b/tests/testthat/test-coord-transform.R @@ -1,4 +1,4 @@ -test_that("warnings are generated when cord_trans() results in new infinite values", { +test_that("warnings are generated when coord_trans() results in new infinite values", { p <- ggplot(head(diamonds, 20)) + geom_bar(aes(x = cut)) + coord_trans(y = "log10") @@ -59,7 +59,7 @@ test_that("coord_trans(y = 'log10') expands the x axis identically to scale_y_lo }) test_that("coord_trans() expands axes outside the domain of the axis trans", { - # sqrt_trans() has a lower limit of 0 + # transform_sqrt() has a lower limit of 0 df <- data_frame(x = 1, y = c(0, 1, 2)) p <- ggplot(df, aes(x, y)) + geom_point() built_cartesian <- ggplot_build(p + scale_y_sqrt()) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index c8ee9b2bb8..96c90efe96 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -350,7 +350,7 @@ test_that("legend directions are set correctly", { test_that("guide_axis_logticks calculates appropriate ticks", { - test_scale <- function(trans = identity_trans(), limits = c(NA, NA)) { + test_scale <- function(trans = transform_identity(), limits = c(NA, NA)) { scale <- scale_x_continuous(trans = trans) scale$train(scale$transform(limits)) view_scale_primary(scale) @@ -366,28 +366,28 @@ test_that("guide_axis_logticks calculates appropriate ticks", { outcome <- c((1:10)*10, (2:10)*100) # Test the classic log10 transformation - scale <- test_scale(log10_trans(), c(10, 1000)) + scale <- test_scale(transform_log10(), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), log10(outcome)) expect_equal(key$.type, rep(c(1,2,3), c(3, 2, 14))) # Test compound transformation - scale <- test_scale(compose_trans(log10_trans(), reverse_trans()), c(10, 1000)) + scale <- test_scale(transform_compose(transform_log10(), transform_reverse()), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), -log10(rev(outcome))) # Test transformation with negatives - scale <- test_scale(pseudo_log_trans(), c(-1000, 1000)) + scale <- test_scale(transform_pseudo_log(), c(-1000, 1000)) key <- train_guide(guide, scale)$logkey - unlog <- sort(pseudo_log_trans()$inverse(key$x)) + unlog <- sort(transform_pseudo_log()$inverse(key$x)) expect_equal(unlog, c(-rev(outcome), 0, outcome)) expect_equal(key$.type, rep(c(1,2,3), c(7, 4, 28))) # Test expanded argument - scale <- test_scale(log10_trans(), c(20, 900)) + scale <- test_scale(transform_log10(), c(20, 900)) scale$continuous_range <- c(1, 3) guide <- guide_axis_logticks(expanded = TRUE) @@ -408,7 +408,7 @@ test_that("guide_axis_logticks calculates appropriate ticks", { expect_equal(sort(key$x), log2(outcome)) # Should warn when scale also has transformation - scale <- test_scale(log10_trans(), limits = c(10, 1000)) + scale <- test_scale(transform_log10(), limits = c(10, 1000)) expect_snapshot_warning(train_guide(guide, scale)$logkey) }) @@ -631,12 +631,12 @@ test_that("logticks look as they should", { p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + geom_point() + - scale_y_continuous(trans = compose_trans(log10_trans(), reverse_trans()), + scale_y_continuous(trans = transform_compose(transform_log10(), transform_reverse()), expand = expansion(add = 0.5)) + scale_x_continuous( breaks = c(-100, -10, -1, 0, 1, 10, 100) ) + - coord_trans(x = pseudo_log_trans()) + + coord_trans(x = transform_pseudo_log()) + theme_test() + theme(axis.line = element_line(colour = "black"), panel.border = element_blank(), diff --git a/tests/testthat/test-scale-expansion.R b/tests/testthat/test-scale-expansion.R index 13f7297727..7d1b5b30ae 100644 --- a/tests/testthat/test-scale-expansion.R +++ b/tests/testthat/test-scale-expansion.R @@ -31,7 +31,7 @@ test_that("expand_limits_continuous_trans() expands limits in coordinate space", limit_info <- expand_limits_continuous_trans( c(1, 2), expand = expansion(add = 0.5), - trans = log10_trans() + trans = transform_log10() ) expect_identical( @@ -49,7 +49,7 @@ test_that("introduced non-finite values fall back on scale limits", { limit_info <- expand_limits_continuous_trans( c(1, 100), expand = expansion(add = 2), - trans = sqrt_trans() + trans = transform_sqrt() ) expect_identical(limit_info$continuous_range, c(1, (sqrt(100) + 2)^2)) @@ -102,7 +102,7 @@ test_that("expand_limits_continuous_trans() works with inverted transformations" limit_info <- expand_limits_continuous_trans( c(1, 2), expand = expansion(add = 1), - trans = reverse_trans() + trans = transform_reverse() ) expect_identical(limit_info$continuous_range, c(0, 3)) diff --git a/tests/testthat/test-scale-hue.R b/tests/testthat/test-scale-hue.R index 5f3cc779e8..12568590a8 100644 --- a/tests/testthat/test-scale-hue.R +++ b/tests/testthat/test-scale-hue.R @@ -1,8 +1,8 @@ test_that("scale_hue() checks the type input", { - pal <- qualitative_pal(type = 1:4) + pal <- pal_qualitative(type = 1:4) expect_snapshot_error(pal(4)) - pal <- qualitative_pal(type = colors()) + pal <- pal_qualitative(type = colors()) expect_silent(pal(4)) - pal <- qualitative_pal(type = list(colors()[1:10], colors()[11:30])) + pal <- pal_qualitative(type = list(colors()[1:10], colors()[11:30])) expect_silent(pal(4)) }) diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index 1516519512..344d823d58 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -115,7 +115,7 @@ test_that("discrete labels match breaks", { }) test_that("scale breaks work with numeric log transformation", { - sc <- scale_x_continuous(limits = c(1, 1e5), trans = log10_trans()) + sc <- scale_x_continuous(limits = c(1, 1e5), trans = transform_log10()) expect_equal(sc$get_breaks(), c(0, 2, 4)) # 1, 100, 10000 expect_equal(sc$get_breaks_minor(), c(0, 1, 2, 3, 4, 5)) }) @@ -297,15 +297,15 @@ test_that("minor breaks draw correctly", { expect_doppelganger("numeric-log", ggplot(df, aes(x_log, x_log)) + - scale_x_continuous(trans = log2_trans()) + + scale_x_continuous(trans = transform_log2()) + scale_y_log10() + labs(x = NULL, y = NULL) + theme ) expect_doppelganger("numeric-exp", ggplot(df, aes(x_num, x_num)) + - scale_x_continuous(trans = exp_trans(2)) + - scale_y_continuous(trans = exp_trans(2)) + + scale_x_continuous(trans = transform_exp(2)) + + scale_y_continuous(trans = transform_exp(2)) + labs(x = NULL, y = NULL) + theme ) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 2b1c80729d..70d5b7dd27 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -476,13 +476,13 @@ test_that("numeric scale transforms can produce breaks", { expect_equal(test_breaks("atanh", limits = c(-0.9, 0.9)), c(NA, -0.5, 0, 0.5, NA)) - # Broken, should fix on {scale}'s side - # expect_equal(test_breaks(boxcox_trans(0), limits = c(0, 10)), ...) + expect_equal(test_breaks(transform_boxcox(0), limits = c(1, 10)), + c(NA, 2.5, 5.0, 7.5, 10)) - expect_equal(test_breaks(modulus_trans(0), c(-10, 10)), + expect_equal(test_breaks(transform_modulus(0), c(-10, 10)), seq(-10, 10, by = 5)) - expect_equal(test_breaks(yj_trans(0), c(-10, 10)), + expect_equal(test_breaks(transform_yj(0), c(-10, 10)), seq(-10, 10, by = 5)) expect_equal(test_breaks("exp", c(-10, 10)), @@ -707,8 +707,8 @@ test_that("find_scale appends appropriate calls", { test_that("Using `scale_name` prompts deprecation message", { - expect_snapshot_warning(continuous_scale("x", "foobar", identity_pal())) - expect_snapshot_warning(discrete_scale("x", "foobar", identity_pal())) - expect_snapshot_warning(binned_scale("x", "foobar", identity_pal())) + expect_snapshot_warning(continuous_scale("x", "foobar", pal_identity())) + expect_snapshot_warning(discrete_scale("x", "foobar", pal_identity())) + expect_snapshot_warning(binned_scale("x", "foobar", pal_identity())) }) diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index d77ee102bf..7dcba15139 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -231,7 +231,7 @@ test_that("sec_axis() respects custom transformations", { } }) - trans_new(name = "customlog", transform = trans, inverse = inv, domain = c(1e-16, Inf)) + new_transform(name = "customlog", transform = trans, inverse = inv, domain = c(1e-16, Inf)) } # Create data @@ -335,7 +335,7 @@ test_that("sec.axis allows independent trans btwn primary and secondary axes", { "sec_axis, independent transformations", ggplot(data = data, aes(Probability, Value)) + geom_point() + scale_x_continuous( - trans = scales::probability_trans(distribution = "norm", lower.tail = FALSE), + trans = scales::transform_probability(distribution = "norm", lower.tail = FALSE), sec.axis = sec_axis(trans = ~ 1 / ., name = "Return Period") ) + theme_linedraw() ) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index 66a610babe..0b856abe72 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -834,7 +834,7 @@ facet_trans <- function(trans, horizontal = TRUE, shrink = TRUE) { ggproto(NULL, FacetTrans, shrink = shrink, params = list( - trans = scales::as.trans(trans), + trans = scales::as.transform(trans), horizontal = horizontal ) ) From 4a3dd712581365c85dcd1477edf2a968a8115b51 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Mon, 4 Dec 2023 10:15:29 -0500 Subject: [PATCH 04/22] Review error messages (#5557) * Add full stops to error messages. * Remove self-ref * Replace `expect_snapshot_warning` and `expect_snapshot_error()` with `expect_snapshot()`. * Review and accept snapshots * error msg * style * typo * Revert "Replace `expect_snapshot_warning` and `expect_snapshot_error()` with `expect_snapshot()`." This reverts commit 3b7dcc78200421167fdc8a0cf94956221ba9d679. * change * Update snapshots * Adjust failing tests * Apply suggestions from code review Co-authored-by: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> * Apply suggestions from teunbrand --------- Co-authored-by: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> --- R/aes.R | 2 +- R/annotation-custom.R | 2 +- R/annotation-map.R | 2 +- R/annotation-raster.R | 2 +- R/annotation.R | 2 +- R/autolayer.R | 2 +- R/autoplot.R | 2 +- R/axis-secondary.R | 6 ++--- R/bin.R | 10 +++---- R/compat-plyr.R | 4 +-- R/coord-.R | 10 +++---- R/coord-sf.R | 10 +++---- R/facet-.R | 18 ++++++------- R/facet-grid-.R | 14 +++++----- R/facet-wrap.R | 6 ++--- R/fortify.R | 4 +-- R/geom-.R | 4 +-- R/geom-boxplot.R | 2 +- R/geom-jitter.R | 4 +-- R/geom-label.R | 6 ++--- R/geom-linerange.R | 2 +- R/geom-map.R | 2 +- R/geom-path.R | 7 +---- R/geom-point.R | 6 ++--- R/geom-polygon.R | 4 +-- R/geom-raster.R | 2 +- R/geom-ribbon.R | 13 +++++----- R/geom-sf.R | 10 +++---- R/geom-text.R | 4 +-- R/geom-violin.R | 2 +- R/ggproto.R | 6 ++--- R/guide-axis.R | 11 +++----- R/guide-legend.R | 2 +- R/labeller.R | 6 ++--- R/layer.R | 6 ++--- R/layout.R | 4 +-- R/limits.R | 12 ++++----- R/plot-build.R | 18 +++++++++---- R/plot-construction.R | 4 +-- R/plot.R | 20 +++++++------- R/position-.R | 2 +- R/position-collide.R | 8 +++--- R/position-jitterdodge.R | 8 ++++-- R/position-stack.R | 2 +- R/save.R | 11 ++++---- R/scale-.R | 24 ++++++++--------- R/scale-colour.R | 10 +++---- R/scale-expansion.R | 4 +-- R/scale-hue.R | 2 +- R/scale-linetype.R | 4 +-- R/scale-shape.R | 4 +-- R/scale-view.R | 4 +-- R/stat-.R | 6 ++--- R/stat-bin.R | 2 +- R/stat-density-2d.R | 12 ++++----- R/stat-density.R | 2 +- R/stat-qq-line.R | 2 +- R/stat-qq.R | 2 +- R/stat-ydensity.R | 4 +-- R/theme.R | 18 ++++++------- R/utilities-break.R | 2 +- R/utilities.R | 6 ++--- R/zzz.R | 4 +-- man/annotate.Rd | 2 +- tests/testthat/_snaps/aes.md | 2 +- tests/testthat/_snaps/annotate.md | 6 ++--- tests/testthat/_snaps/autolayer.md | 2 +- tests/testthat/_snaps/autoplot.md | 2 +- tests/testthat/_snaps/compat-plyr.md | 4 +-- tests/testthat/_snaps/coord-.md | 10 +++---- tests/testthat/_snaps/coord_sf.md | 6 ++--- tests/testthat/_snaps/error.md | 4 +-- tests/testthat/_snaps/facet-.md | 14 +++++----- tests/testthat/_snaps/facet-layout.md | 22 ++++++++-------- tests/testthat/_snaps/facet-strips.md | 2 +- tests/testthat/_snaps/geom-.md | 4 +-- tests/testthat/_snaps/geom-boxplot.md | 2 +- tests/testthat/_snaps/geom-dotplot.md | 4 +-- tests/testthat/_snaps/geom-jitter.md | 4 +-- tests/testthat/_snaps/geom-label.md | 6 ++--- tests/testthat/_snaps/geom-linerange.md | 2 +- tests/testthat/_snaps/geom-map.md | 2 +- tests/testthat/_snaps/geom-path.md | 2 +- tests/testthat/_snaps/geom-point.md | 6 ++--- tests/testthat/_snaps/geom-raster.md | 2 +- tests/testthat/_snaps/geom-ribbon.md | 2 +- tests/testthat/_snaps/geom-sf.md | 14 ++++++---- tests/testthat/_snaps/geom-text.md | 4 +-- tests/testthat/_snaps/geom-violin.md | 4 +-- tests/testthat/_snaps/ggsave.md | 3 +-- tests/testthat/_snaps/guides.md | 2 +- tests/testthat/_snaps/labellers.md | 6 ++--- tests/testthat/_snaps/layer.md | 12 ++++----- tests/testthat/_snaps/limits.md | 4 +-- tests/testthat/_snaps/plot.md | 8 +++--- tests/testthat/_snaps/position-collide.md | 4 +-- tests/testthat/_snaps/position-jitterdodge.md | 3 ++- .../_snaps/scale-colour-continuous.md | 6 ++--- tests/testthat/_snaps/scale-discrete.md | 8 +++--- tests/testthat/_snaps/scale-expansion.md | 4 +-- tests/testthat/_snaps/scale-hue.md | 2 +- tests/testthat/_snaps/scales.md | 26 +++++++++---------- tests/testthat/_snaps/sec-axis.md | 6 ++--- tests/testthat/_snaps/stat-bin.md | 18 ++++++------- tests/testthat/_snaps/stat-bin2d.md | 4 +-- tests/testthat/_snaps/stat-density2d.md | 3 +-- tests/testthat/_snaps/stat-qq.md | 10 +++---- tests/testthat/_snaps/stat-ydensity.md | 4 +-- tests/testthat/_snaps/stats.md | 6 +++++ tests/testthat/_snaps/theme.md | 10 +++---- tests/testthat/_snaps/utilities.md | 10 +++---- tests/testthat/test-ggsave.R | 2 +- tests/testthat/test-stats.R | 7 +++-- 113 files changed, 353 insertions(+), 345 deletions(-) create mode 100644 tests/testthat/_snaps/stats.md diff --git a/R/aes.R b/R/aes.R index 9ce54cbd47..87870bccb1 100644 --- a/R/aes.R +++ b/R/aes.R @@ -425,7 +425,7 @@ alternative_aes_extract_usage <- function(x) { } else if (is_call(x, "$")) { as.character(x[[3]]) } else { - cli::cli_abort("Don't know how to get alternative usage for {.var {x}}") + cli::cli_abort("Don't know how to get alternative usage for {.var {x}}.") } } diff --git a/R/annotation-custom.R b/R/annotation-custom.R index e93fb717e3..4261526b89 100644 --- a/R/annotation-custom.R +++ b/R/annotation-custom.R @@ -71,7 +71,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, draw_panel = function(data, panel_params, coord, grob, xmin, xmax, ymin, ymax) { if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}") + cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}.") } corners <- data_frame0( x = c(xmin, xmax), diff --git a/R/annotation-map.R b/R/annotation-map.R index d92195170c..86fd0e0952 100644 --- a/R/annotation-map.R +++ b/R/annotation-map.R @@ -63,7 +63,7 @@ annotation_map <- function(map, ...) { if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region if (!all(c("x", "y", "id") %in% names(map))) { - cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}") + cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}.") } layer( diff --git a/R/annotation-raster.R b/R/annotation-raster.R index 21c038f773..8eb8685883 100644 --- a/R/annotation-raster.R +++ b/R/annotation-raster.R @@ -74,7 +74,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, draw_panel = function(data, panel_params, coord, raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { if (!inherits(coord, "CoordCartesian")) { - cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}") + cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}.") } corners <- data_frame0( x = c(xmin, xmax), diff --git a/R/annotation.R b/R/annotation.R index d185cf5698..00e96f64c7 100644 --- a/R/annotation.R +++ b/R/annotation.R @@ -13,7 +13,7 @@ #' #' @section Unsupported geoms: #' Due to their special nature, reference line geoms [geom_abline()], -#' [geom_hline()], and [geom_vline()] can't be used with [annotate()]. +#' [geom_hline()], and [geom_vline()] can't be used with `annotate()`. #' You can use these geoms directly for annotations. #' @param geom name of geom to use for annotation #' @param x,y,xmin,ymin,xmax,ymax,xend,yend positioning aesthetics - diff --git a/R/autolayer.R b/R/autolayer.R index a1f7d0ba15..88129ef212 100644 --- a/R/autolayer.R +++ b/R/autolayer.R @@ -15,5 +15,5 @@ autolayer <- function(object, ...) { #' @export autolayer.default <- function(object, ...) { - cli::cli_abort("No autolayer method available for {.cls {class(object)[1]}} objects") + cli::cli_abort("No autolayer method available for {.cls {class(object)[1]}} objects.") } diff --git a/R/autoplot.R b/R/autoplot.R index f31a411ac5..a2a36e972b 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -17,7 +17,7 @@ autoplot <- function(object, ...) { autoplot.default <- function(object, ...) { cli::cli_abort(c( "Objects of class {.cls {class(object)[[1]]}} are not supported by autoplot.", - "i" = "have you loaded the required package?" + "i" = "Have you loaded the required package?" )) } diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 1d44fe967b..06565358c6 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -123,7 +123,7 @@ set_sec_axis <- function(sec.axis, scale) { if (!is.waive(sec.axis)) { if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis) if (!is.sec_axis(sec.axis)) { - cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}") + cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}.") } scale$secondary.axis <- sec.axis } @@ -165,7 +165,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, return() } if (!is.function(self$trans)) { - cli::cli_abort("Transformation for secondary axes must be a function") + cli::cli_abort("Transformation for secondary axes must be a function.") } if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks @@ -194,7 +194,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Test for monotonicity if (!is_unique(sign(diff(full_range)))) - cli::cli_abort("Transformation for secondary axes must be monotonic") + cli::cli_abort("Transformation for secondary axes must be monotonic.") }, break_info = function(self, range, scale) { diff --git a/R/bin.R b/R/bin.R index 7244b9ffe1..5cb1a948ee 100644 --- a/R/bin.R +++ b/R/bin.R @@ -51,13 +51,11 @@ bin_breaks <- function(breaks, closed = c("right", "left")) { bin_breaks_width <- function(x_range, width = NULL, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements") + cli::cli_abort("{.arg x_range} must have two elements.") } - check_number_decimal(width) - if (width <= 0) { - cli::cli_abort("{.arg binwidth} must be positive") - } + # binwidth seems to be the argument name supplied to width. (stat-bin and stat-bindot) + check_number_decimal(width, min = 0, allow_infinite = FALSE, arg = "binwidth") if (!is.null(boundary) && !is.null(center)) { cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.") @@ -105,7 +103,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL, bin_breaks_bins <- function(x_range, bins = 30, center = NULL, boundary = NULL, closed = c("right", "left")) { if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements") + cli::cli_abort("{.arg x_range} must have two elements.") } check_number_whole(bins, min = 1) diff --git a/R/compat-plyr.R b/R/compat-plyr.R index 0f8306a4ab..95c317a02c 100644 --- a/R/compat-plyr.R +++ b/R/compat-plyr.R @@ -19,7 +19,7 @@ unrowname <- function(x) { } else if (is.matrix(x)) { dimnames(x)[1] <- list(NULL) } else { - cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects") + cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.") } x } @@ -239,7 +239,7 @@ as.quoted <- function(x, env = parent.frame()) { } else if (is.call(x)) { as.list(x)[-1] } else { - cli::cli_abort("Must be a character vector, call, or formula") + cli::cli_abort("Must be a character vector, call, or formula.") } attributes(x) <- list(env = env, class = 'quoted') x diff --git a/R/coord-.R b/R/coord-.R index d69248a2c6..8c4313baf7 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -66,27 +66,27 @@ Coord <- ggproto("Coord", render_fg = function(panel_params, theme) element_render(theme, "panel.border"), render_bg = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_bg} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_bg} method.") }, render_axis_h = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_h} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_h} method.") }, render_axis_v = function(self, panel_params, theme) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_v} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn render_axis_v} method.") }, # transform range given in transformed coordinates # back into range in given in (possibly scale-transformed) # data coordinates backtransform_range = function(self, panel_params) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn backtransform_range} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn backtransform_range} method.") }, # return range stored in panel_params range = function(self, panel_params) { - cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method") + cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method.") }, setup_panel_params = function(scale_x, scale_y, params = list()) { diff --git a/R/coord-sf.R b/R/coord-sf.R index 9f323a42f3..331ca4f1f0 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -127,7 +127,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(x_labels) != length(x_breaks)) { - cli::cli_abort("Breaks and labels along x direction are different lengths") + cli::cli_abort("{.arg breaks} and {.arg labels} along {.code x} direction have different lengths.") } graticule$degree_label[graticule$type == "E"] <- x_labels @@ -152,7 +152,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(y_labels) != length(y_breaks)) { - cli::cli_abort("Breaks and labels along y direction are different lengths") + cli::cli_abort("{.arg breaks} and {.arg labels} along {.code y} direction have different lengths.") } graticule$degree_label[graticule$type == "N"] <- y_labels @@ -203,7 +203,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, if (self$lims_method != "geometry_bbox") { cli::cli_warn(c( "Projection of {.field x} or {.field y} limits failed in {.fn coord_sf}.", - "i" = "Consider setting {.code lims_method = \"geometry_bbox\"} or {.code default_crs = NULL}." + "i" = "Consider setting {.code lims_method = {.val geometry_bbox}} or {.code default_crs = NULL}." )) } coord_bbox <- self$params$bbox @@ -409,7 +409,7 @@ sf_rescale01 <- function(x, x_range, y_range) { calc_limits_bbox <- function(method, xlim, ylim, crs, default_crs) { if (any(!is.finite(c(xlim, ylim))) && method != "geometry_bbox") { cli::cli_abort(c( - "Scale limits cannot be mapped onto spatial coordinates in {.fn coord_sf}", + "Scale limits cannot be mapped onto spatial coordinates in {.fn coord_sf}.", "i" = "Consider setting {.code lims_method = \"geometry_bbox\"} or {.code default_crs = NULL}." )) } @@ -542,14 +542,12 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, label_axes <- parse_axes_labeling(label_axes) } else if (!is.list(label_axes)) { cli::cli_abort("Panel labeling format not recognized.") - label_axes <- list(left = "N", bottom = "E") } if (is.character(label_graticule)) { label_graticule <- unlist(strsplit(label_graticule, "")) } else { cli::cli_abort("Graticule labeling format not recognized.") - label_graticule <- "" } # switch limit method to "orthogonal" if not specified and default_crs indicates projected coords diff --git a/R/facet-.R b/R/facet-.R index 46e5a1c61f..f26b602f89 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -83,10 +83,10 @@ Facet <- ggproto("Facet", NULL, params = list(), compute_layout = function(data, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, map_data = function(data, layout, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) { scales <- list() @@ -132,7 +132,7 @@ Facet <- ggproto("Facet", NULL, rep(list(zeroGrob()), vec_unique_count(layout$PANEL)) }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, draw_labels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, labels, params) { panel_dim <- find_panel(panels) @@ -323,13 +323,13 @@ as_facets_list <- function(x) { validate_facets <- function(x) { if (inherits(x, "uneval")) { - cli::cli_abort("Please use {.fn vars} to supply facet variables") + cli::cli_abort("Please use {.fn vars} to supply facet variables.") } # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(x, "gg")) { cli::cli_abort(c( - "Please use {.fn vars} to supply facet variables", + "Please use {.fn vars} to supply facet variables.", "i" = "Did you use {.code %>%} or {.code |>} instead of {.code +}?" )) } @@ -500,7 +500,7 @@ check_layout <- function(x) { return() } - cli::cli_abort("Facet layout has a bad format. It must contain columns {.col PANEL}, {.col SCALE_X}, and {.col SCALE_Y}") + cli::cli_abort("Facet layout has a bad format. It must contain columns {.col PANEL}, {.col SCALE_X}, and {.col SCALE_Y}.") } check_facet_vars <- function(..., name) { @@ -509,8 +509,8 @@ check_facet_vars <- function(..., name) { problems <- intersect(vars_names, reserved_names) if (length(problems) != 0) { cli::cli_abort(c( - "{.val {problems}} {?is/are} not {?an/} allowed name{?/s} for faceting variables", - "i" = "Change the name of your data columns to not be {.or {.str {reserved_names}}}" + "{.val {problems}} {?is/are} not {?an/} allowed name{?/s} for faceting variables.", + "i" = "Change the name of your data columns to not be {.or {.str {reserved_names}}}." ), call = call2(name)) } } @@ -631,7 +631,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) { } if (empty(base)) { - cli::cli_abort("Faceting variables must have at least one value") + cli::cli_abort("Faceting variables must have at least one value.") } base diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 3fa73f98f3..4afccc71f8 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -137,8 +137,8 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed", y = any(space %in% c("free_y", "free")) ) - if (!is.null(switch) && !switch %in% c("both", "x", "y")) { - cli::cli_abort("{.arg switch} must be either {.val both}, {.val x}, or {.val y}") + if (!is.null(switch)) { + arg_match0(switch, c("both", "x", "y")) } facets_list <- grid_as_facets_list(rows, cols) @@ -159,7 +159,7 @@ grid_as_facets_list <- function(rows, cols) { is_rows_vars <- is.null(rows) || is_quosures(rows) if (!is_rows_vars) { if (!is.null(cols)) { - msg <- "{.arg rows} must be {.val NULL} or a {.fn vars} list if {.arg cols} is a {.fn vars} list" + msg <- "{.arg rows} must be {.code NULL} or a {.fn vars} list if {.arg cols} is a {.fn vars} list." # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(rows, "gg")) { @@ -173,7 +173,7 @@ grid_as_facets_list <- function(rows, cols) { # For backward-compatibility facets_list <- as_facets_list(rows) if (length(facets_list) > 2L) { - cli::cli_abort("A grid facet specification can't have more than two dimensions") + cli::cli_abort("A grid facet specification can't have more than two dimensions.") } # Fill with empty quosures facets <- list(rows = quos(), cols = quos()) @@ -206,7 +206,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, dups <- intersect(names(rows), names(cols)) if (length(dups) > 0) { cli::cli_abort(c( - "Faceting variables can only appear in {.arg rows} or {.arg cols}, not both.\n", + "Faceting variables can only appear in {.arg rows} or {.arg cols}, not both.", "i" = "Duplicated variables: {.val {dups}}" ), call = call2(snake_class(self))) } @@ -303,7 +303,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales") + cli::cli_abort("{.fn {snake_class(coord)}} doesn't support free scales.") } cols <- which(layout$ROW == 1) @@ -321,7 +321,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, aspect_ratio <- theme$aspect.ratio if (!is.null(aspect_ratio) && (params$space_free$x || params$space_free$y)) { - cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio") + cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio.") } if (is.null(aspect_ratio) && !params$free$x && !params$free$y) { aspect_ratio <- coord$aspect(ranges[[1]]) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index b7c19a05f3..00c65dd49a 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -217,7 +217,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, }, draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - cli::cli_abort("{.fn {snake_class(self)}} can't use free scales with {.fn {snake_class(coord)}}") + cli::cli_abort("{.fn {snake_class(self)}} can't use free scales with {.fn {snake_class(coord)}}.") } if (inherits(coord, "CoordFlip")) { @@ -470,8 +470,8 @@ wrap_dims <- function(n, nrow = NULL, ncol = NULL) { } if (nrow * ncol < n) { cli::cli_abort(c( - "Need {n} panels, but together {.arg nrow} and {.arg ncol} only provide {nrow * ncol}", - i = "Please increase {.arg ncol} and/or {.arg nrow}" + "Need {n} panel{?s}, but together {.arg nrow} and {.arg ncol} only provide {nrow * ncol}.", + i = "Please increase {.arg ncol} and/or {.arg nrow}." )) } diff --git a/R/fortify.R b/R/fortify.R index 292928bba5..bc046f2400 100644 --- a/R/fortify.R +++ b/R/fortify.R @@ -78,8 +78,8 @@ validate_as_data_frame <- function(data) { fortify.default <- function(model, data, ...) { msg0 <- paste0( "{{.arg data}} must be a {{.cls data.frame}}, ", - "or an object coercible by {{.code fortify()}}, or a valid ", - "{{.cls data.frame}}-like object coercible by {{.code as.data.frame()}}" + "or an object coercible by {{.fn fortify}}, or a valid ", + "{{.cls data.frame}}-like object coercible by {{.fn as.data.frame}}" ) if (inherits(model, "uneval")) { msg <- c( diff --git a/R/geom-.R b/R/geom-.R index b9ff98a71f..9a6966e15b 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -239,8 +239,8 @@ check_aesthetics <- function(x, n) { } cli::cli_abort(c( - "Aesthetics must be either length 1 or the same as the data ({n})", - "x" = "Fix the following mappings: {.col {names(which(!good))}}" + "Aesthetics must be either length 1 or the same as the data ({n}).", + "x" = "Fix the following mappings: {.col {names(which(!good))}}." )) } diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index 2be6c25d69..b4f7777e6f 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -230,7 +230,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # this may occur when using geom_boxplot(stat = "identity") if (nrow(data) != 1) { cli::cli_abort(c( - "Can only draw one boxplot per group", + "Can only draw one boxplot per group.", "i"= "Did you forget {.code aes(group = ...)}?" )) } diff --git a/R/geom-jitter.R b/R/geom-jitter.R index d6ff8eba9a..52f017dccd 100644 --- a/R/geom-jitter.R +++ b/R/geom-jitter.R @@ -44,8 +44,8 @@ geom_jitter <- function(mapping = NULL, data = NULL, if (!missing(width) || !missing(height)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg width}/{.arg height} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg width}/{.arg height} were supplied.", + "i" = "Choose a single approach to alter the position." )) } diff --git a/R/geom-label.R b/R/geom-label.R index be6560b7e6..41ba35f2fc 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -19,8 +19,8 @@ geom_label <- function(mapping = NULL, data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Choose one approach to alter the position." )) } @@ -122,7 +122,7 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) { if (length(label) != 1) { - cli::cli_abort("{.arg label} must be of length 1") + cli::cli_abort("{.arg label} must be of length 1.") } if (!is.unit(x)) diff --git a/R/geom-linerange.R b/R/geom-linerange.R index 1f2c086010..7144d0084a 100644 --- a/R/geom-linerange.R +++ b/R/geom-linerange.R @@ -101,7 +101,7 @@ GeomLinerange <- ggproto("GeomLinerange", Geom, params$flipped_aes <- has_flipped_aes(data, params, range_is_orthogonal = TRUE) # if flipped_aes == TRUE then y, xmin, xmax is present if (!(params$flipped_aes || all(c("x", "ymin", "ymax") %in% c(names(data), names(params))))) { - cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied") + cli::cli_abort("Either, {.field x}, {.field ymin}, and {.field ymax} {.emph or} {.field y}, {.field xmin}, and {.field xmax} must be supplied.") } params }, diff --git a/R/geom-map.R b/R/geom-map.R index 987ee864b4..7ecfd09e0b 100644 --- a/R/geom-map.R +++ b/R/geom-map.R @@ -102,7 +102,7 @@ geom_map <- function(mapping = NULL, data = NULL, if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region if (!all(c("x", "y", "id") %in% names(map))) { - cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}") + cli::cli_abort("{.arg map} must have the columns {.col x}, {.col y}, and {.col id}.") } layer( diff --git a/R/geom-path.R b/R/geom-path.R index 35d69e06fd..cf9e59976c 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -184,7 +184,7 @@ GeomPath <- ggproto("GeomPath", Geom, solid_lines <- all(attr$solid) constant <- all(attr$constant) if (!solid_lines && !constant) { - cli::cli_abort("{.fn {snake_class(self)}} can't have varying {.field colour}, {.field linewidth}, and/or {.field alpha} along the line when {.field linetype} isn't solid") + cli::cli_abort("{.fn {snake_class(self)}} can't have varying {.field colour}, {.field linewidth}, and/or {.field alpha} along the line when {.field linetype} isn't solid.") } # Work out grouping variables for grobs @@ -351,11 +351,6 @@ stairstep <- function(data, direction = "hv") { } else if (direction == "mid") { xs <- rep(1:(n-1), each = 2) ys <- rep(1:n, each = 2) - } else { - cli::cli_abort(c( - "{.arg direction} is invalid.", - "i" = "Use either {.val vh}, {.val hv}, or {.va mid}" - )) } if (direction == "mid") { diff --git a/R/geom-point.R b/R/geom-point.R index 28e688545c..ef9df0b652 100644 --- a/R/geom-point.R +++ b/R/geom-point.R @@ -203,14 +203,14 @@ translate_shape_string <- function(shape_string) { if (any(invalid_strings)) { bad_string <- unique0(shape_string[invalid_strings]) - cli::cli_abort("Shape aesthetic contains invalid value{?s}: {.val {bad_string}}") + cli::cli_abort("Shape aesthetic contains invalid value{?s}: {.val {bad_string}}.") } if (any(nonunique_strings)) { bad_string <- unique0(shape_string[nonunique_strings]) cli::cli_abort(c( - "shape names must be given unambiguously", - "i" = "Fix {.val {bad_string}}" + "Shape names must be given unambiguously.", + "i" = "Fix {.val {bad_string}}." )) } diff --git a/R/geom-polygon.R b/R/geom-polygon.R index cfeefa1d12..2e1efb835c 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -142,8 +142,8 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, ) ) } else { - if (utils::packageVersion('grid') < "3.6") { - cli::cli_abort("Polygons with holes requires R 3.6 or above") + if (getRversion() < "3.6") { + cli::cli_abort("Polygons with holes requires R 3.6 or above.") } # Sort by group to make sure that colors, fill, etc. come in same order munched <- munched[order(munched$group, munched$subgroup), ] diff --git a/R/geom-raster.R b/R/geom-raster.R index b725584082..c3709a7d98 100644 --- a/R/geom-raster.R +++ b/R/geom-raster.R @@ -89,7 +89,7 @@ GeomRaster <- ggproto("GeomRaster", Geom, hjust = 0.5, vjust = 0.5) { if (!inherits(coord, "CoordCartesian")) { cli::cli_abort(c( - "{.fn {snake_class(self)}} only works with {.fn coord_cartesian}" + "{.fn {snake_class(self)}} only works with {.fn coord_cartesian}." )) } diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index e889bb78a1..ed6696bb39 100644 --- a/R/geom-ribbon.R +++ b/R/geom-ribbon.R @@ -137,7 +137,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # Check that aesthetics are constant aes <- unique0(data[names(data) %in% c("colour", "fill", "linewidth", "linetype", "alpha")]) if (nrow(aes) > 1) { - cli::cli_abort("Aesthetics can not vary along a ribbon") + cli::cli_abort("Aesthetics can not vary along a ribbon.") } aes <- as.list(aes) @@ -200,14 +200,15 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # Increment the IDs of the lower line so that they will be drawn as separate lines munched_lower$id <- munched_lower$id + max(ids, na.rm = TRUE) + arg_match0( + outline.type, + c("both", "upper", "lower") + ) + munched_lines <- switch(outline.type, both = vec_rbind0(munched_upper, munched_lower), upper = munched_upper, - lower = munched_lower, - cli::cli_abort(c( - "invalid {.arg outline.type}: {.val {outline.type}}", - "i" = "use either {.val upper}, {.val lower}, or {.val both}" - )) + lower = munched_lower ) g_lines <- polylineGrob( munched_lines$x, munched_lines$y, id = munched_lines$id, diff --git a/R/geom-sf.R b/R/geom-sf.R index d641121682..882da40a64 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -131,7 +131,7 @@ GeomSf <- ggproto("GeomSf", Geom, lineend = "butt", linejoin = "round", linemitre = 10, arrow = NULL, na.rm = TRUE) { if (!inherits(coord, "CoordSf")) { - cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}") + cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.") } # Need to refactor this to generate one grob per geometry type @@ -267,8 +267,8 @@ geom_sf_label <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } @@ -314,8 +314,8 @@ geom_sf_text <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } diff --git a/R/geom-text.R b/R/geom-text.R index 0f4ed1918e..b8c98f7fba 100644 --- a/R/geom-text.R +++ b/R/geom-text.R @@ -170,8 +170,8 @@ geom_text <- function(mapping = NULL, data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { cli::cli_abort(c( - "both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied", - "i" = "Only use one approach to alter the position" + "Both {.arg position} and {.arg nudge_x}/{.arg nudge_y} are supplied.", + "i" = "Only use one approach to alter the position." )) } diff --git a/R/geom-violin.R b/R/geom-violin.R index c2bfc9f087..4b73100f5d 100644 --- a/R/geom-violin.R +++ b/R/geom-violin.R @@ -164,7 +164,7 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { - cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1") + cli::cli_abort("{.arg draw_quantiles} must be between 0 and 1.") } # Compute the quantile segments and combine with existing aesthetics diff --git a/R/ggproto.R b/R/ggproto.R index 5df2f1d116..e9ccfcf997 100644 --- a/R/ggproto.R +++ b/R/ggproto.R @@ -118,9 +118,9 @@ fetch_ggproto <- function(x, name) { res <- fetch_ggproto(super(), name) } else { cli::cli_abort(c( - "{class(x)[[1]]} was built with an incompatible version of ggproto.", - "i" = "Please reinstall the package that provides this extension. - ")) + "{class(x)[[1]]} was built with an incompatible version of ggproto.", + "i" = "Please reinstall the package that provides this extension." + )) } } diff --git a/R/guide-axis.R b/R/guide-axis.R index 0e8e49215c..efca81c08e 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -570,6 +570,10 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { check_number_decimal(angle) angle <- angle %% 360 + arg_match0( + axis_position, + c("bottom", "left", "top", "right") + ) if (axis_position == "bottom") { @@ -591,13 +595,6 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { hjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0 vjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0 - } else { - - cli::cli_abort(c( - "Unrecognized {.arg axis_position}: {.val {axis_position}}", - "i" = "Use one of {.val top}, {.val bottom}, {.val left} or {.val right}" - )) - } element_text(angle = angle, hjust = hjust, vjust = vjust) diff --git a/R/guide-legend.R b/R/guide-legend.R index cb5d671393..056ca8f68b 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -395,7 +395,7 @@ GuideLegend <- ggproto( params$nrow * params$ncol < n_breaks) { cli::cli_abort(paste0( "{.arg nrow} * {.arg ncol} needs to be larger than the number of ", - "breaks ({n_breaks})" + "breaks ({n_breaks})." )) } if (is.null(params$nrow) && is.null(params$ncol)) { diff --git a/R/labeller.R b/R/labeller.R index 8d2a3884be..442f05d496 100644 --- a/R/labeller.R +++ b/R/labeller.R @@ -241,12 +241,12 @@ is_labeller <- function(x) inherits(x, "labeller") resolve_labeller <- function(rows, cols, labels) { if (is.null(cols) && is.null(rows)) { - cli::cli_abort("Supply one of {.arg rows} or {.arg cols}") + cli::cli_abort("Supply one of {.arg rows} or {.arg cols}.") } if (attr(labels, "facet") == "wrap") { # Return either rows or cols for facet_wrap() if (!is.null(cols) && !is.null(rows)) { - cli::cli_abort("Cannot supply both {.arg rows} and {.arg cols} to {.fn facet_wrap}") + cli::cli_abort("Cannot supply both {.arg rows} and {.arg cols} to {.fn facet_wrap}.") } cols %||% rows } else { @@ -441,7 +441,7 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Check that variable-specific labellers do not overlap with # margin-wide labeller if (any(names(dots) %in% names(labels))) { - cli::cli_abort("Conflict between {.var {paste0('.', attr(labels, 'type'))}} and {.var {names(dots)}}") + cli::cli_abort("Conflict between {.var {paste0('.', attr(labels, 'type'))}} and {.var {names(dots)}}.") } } diff --git a/R/layer.R b/R/layer.R index 9686aec881..eb590f8dea 100644 --- a/R/layer.R +++ b/R/layer.R @@ -171,7 +171,7 @@ layer <- function(geom = NULL, stat = NULL, validate_mapping <- function(mapping, call = caller_env()) { if (!inherits(mapping, "uneval")) { - msg <- paste0("{.arg mapping} must be created by {.fn aes}") + msg <- "{.arg mapping} must be created by {.fn aes}." # Native pipe have higher precedence than + so any type of gg object can be # expected here, not just ggplot if (inherits(mapping, "gg")) { @@ -221,7 +221,7 @@ Layer <- ggproto("Layer", NULL, } else if (is.function(self$data)) { data <- self$data(plot_data) if (!is.data.frame(data)) { - cli::cli_abort("{.fn layer_data} must return a {.cls data.frame}") + cli::cli_abort("{.fn layer_data} must return a {.cls data.frame}.") } } else { data <- self$data @@ -445,7 +445,7 @@ check_subclass <- function(x, subclass, obj <- find_global(name, env = env) if (is.null(obj) || !inherits(obj, subclass)) { - cli::cli_abort("Can't find {argname} called {.val {x}}", call = call) + cli::cli_abort("Can't find {argname} called {.val {x}}.", call = call) } else { obj } diff --git a/R/layout.R b/R/layout.R index e6a292932c..150d9abe59 100644 --- a/R/layout.R +++ b/R/layout.R @@ -306,8 +306,8 @@ scale_apply <- function(data, vars, method, scale_id, scales) { if (length(vars) == 0) return() if (nrow(data) == 0) return() - if (any(is.na(scale_id))) { - cli::cli_abort("{.arg scale_id} must not contain any {.val NA}") + if (anyNA(scale_id)) { + cli::cli_abort("{.arg scale_id} must not contain any {.val NA}.") } scale_index <- split_with_index(seq_along(scale_id), scale_id, length(scales)) diff --git a/R/limits.R b/R/limits.R index 727df98326..be1a42ba6f 100644 --- a/R/limits.R +++ b/R/limits.R @@ -80,8 +80,8 @@ lims <- function(...) { args <- list2(...) - if (any(!has_name(args))) { - cli::cli_abort("All arguments must be named") + if (!all(has_name(args))) { + cli::cli_abort("All arguments must be named.") } env <- current_env() Map(limits, args, names(args), rep(list(env), length(args))) @@ -114,7 +114,7 @@ limits <- function(lims, var, call = caller_env()) UseMethod("limits") #' @export limits.numeric <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } if (!any(is.na(lims)) && lims[1] > lims[2]) { trans <- "reverse" @@ -144,21 +144,21 @@ limits.factor <- function(lims, var, call = caller_env()) { #' @export limits.Date <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("date", var, limits = lims, call = call) } #' @export limits.POSIXct <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("datetime", var, limits = lims, call = call) } #' @export limits.POSIXlt <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) + cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) } make_scale("datetime", var, limits = as.POSIXct(lims), call = call) } diff --git a/R/plot-build.R b/R/plot-build.R index 10ffaa9ae5..cc2790d7ed 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -362,7 +362,12 @@ by_layer <- function(f, layers, data, step = NULL) { out[[i]] <- f(l = layers[[i]], d = data[[i]]) }, error = function(cnd) { - cli::cli_abort(c("Problem while {step}.", "i" = "Error occurred in the {ordinal(i)} layer."), call = layers[[i]]$constructor, parent = cnd) + cli::cli_abort(c( + "Problem while {step}.", + "i" = "Error occurred in the {ordinal(i)} layer."), + call = layers[[i]]$constructor, + parent = cnd + ) } ) out @@ -391,14 +396,16 @@ table_add_tag <- function(table, label, theme) { if (location == "margin") { cli::cli_abort(paste0( "A {.cls numeric} {.arg plot.tag.position} cannot be used with ", - "{.code \"margin\"} as {.arg plot.tag.location}." - )) + "`{.val margin}` as {.arg plot.tag.location}." + ), + call = expr(theme())) } if (length(position) != 2) { cli::cli_abort(paste0( "A {.cls numeric} {.arg plot.tag.position} ", "theme setting must have length 2." - )) + ), + call = expr(theme())) } top <- left <- right <- bottom <- FALSE } else { @@ -407,7 +414,8 @@ table_add_tag <- function(table, label, theme) { position[1], c("topleft", "top", "topright", "left", "right", "bottomleft", "bottom", "bottomright"), - arg_nm = "plot.tag.position" + arg_nm = "plot.tag.position", + error_call = expr(theme()) ) top <- position %in% c("topleft", "top", "topright") left <- position %in% c("topleft", "left", "bottomleft") diff --git a/R/plot-construction.R b/R/plot-construction.R index c4cafd2dc8..b6d83fe1f0 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -42,7 +42,7 @@ "+.gg" <- function(e1, e2) { if (missing(e2)) { cli::cli_abort(c( - "Cannot use {.code +} with a single argument", + "Cannot use {.code +} with a single argument.", "i" = "Did you accidentally put {.code +} on a new line?" )) } @@ -55,7 +55,7 @@ else if (is.ggplot(e1)) add_ggplot(e1, e2, e2name) else if (is.ggproto(e1)) { cli::cli_abort(c( - "Cannot add {.cls ggproto} objects together", + "Cannot add {.cls ggproto} objects together.", "i" = "Did you forget to add this object to a {.cls ggplot} object?" )) } diff --git a/R/plot.R b/R/plot.R index 4494b774bc..7adbbfd4de 100644 --- a/R/plot.R +++ b/R/plot.R @@ -18,12 +18,12 @@ #' The first pattern is recommended if all layers use the same #' data and the same set of aesthetics, although this method #' can also be used when adding a layer using data from another -#' data frame. +#' data frame. #' #' The second pattern specifies the default data frame to use #' for the plot, but no aesthetics are defined up front. This #' is useful when one data frame is used predominantly for the -#' plot, but the aesthetics vary from one layer to another. +#' plot, but the aesthetics vary from one layer to another. #' #' The third pattern initializes a skeleton `ggplot` object, which #' is fleshed out as layers are added. This is useful when @@ -48,22 +48,22 @@ #' # Create a data frame with some sample data, then create a data frame #' # containing the mean value for each group in the sample data. #' set.seed(1) -#' +#' #' sample_df <- data.frame( #' group = factor(rep(letters[1:3], each = 10)), #' value = rnorm(30) #' ) -#' +#' #' group_means_df <- setNames( #' aggregate(value ~ group, sample_df, mean), #' c("group", "group_mean") #' ) -#' +#' #' # The following three code blocks create the same graphic, each using one #' # of the three patterns specified above. In each graphic, the sample data #' # are plotted in the first layer and the group means data frame is used to #' # plot larger red points on top of the sample data in the second layer. -#' +#' #' # Pattern 1 #' # Both the `data` and `mapping` arguments are passed into the `ggplot()` #' # call. Those arguments are omitted in the first `geom_point()` layer @@ -76,7 +76,7 @@ #' mapping = aes(y = group_mean), data = group_means_df, #' colour = 'red', size = 3 #' ) -#' +#' #' # Pattern 2 #' # Same plot as above, passing only the `data` argument into the `ggplot()` #' # call. The `mapping` arguments are now required in each `geom_point()` @@ -88,7 +88,7 @@ #' mapping = aes(x = group, y = group_mean), data = group_means_df, #' colour = 'red', size = 3 #' ) -#' +#' #' # Pattern 3 #' # Same plot as above, passing neither the `data` or `mapping` arguments #' # into the `ggplot()` call. Both those arguments are now required in @@ -111,8 +111,8 @@ ggplot.default <- function(data = NULL, mapping = aes(), ..., environment = parent.frame()) { if (!missing(mapping) && !inherits(mapping, "uneval")) { cli::cli_abort(c( - "{.arg mapping} should be created with {.fn aes}.", - "x" = "You've supplied a {.cls {class(mapping)[1]}} object" + "{.arg mapping} must be created with {.fn aes}.", + "x" = "You've supplied {.obj_type_friendly {mapping}}." )) } diff --git a/R/position-.R b/R/position-.R index e9ea2ddf6f..23d66579b4 100644 --- a/R/position-.R +++ b/R/position-.R @@ -63,7 +63,7 @@ Position <- ggproto("Position", }, compute_panel = function(self, data, params, scales) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") } ) diff --git a/R/position-collide.R b/R/position-collide.R index 731f467b00..402f6ad7eb 100644 --- a/R/position-collide.R +++ b/R/position-collide.R @@ -5,12 +5,12 @@ collide_setup <- function(data, width = NULL, name, strategy, # Determine width if (!is.null(width)) { # Width set manually - if (!(all(c("xmin", "xmax") %in% names(data)))) { + if (!all(c("xmin", "xmax") %in% names(data))) { data$xmin <- data$x - width / 2 data$xmax <- data$x + width / 2 } } else { - if (!(all(c("xmin", "xmax") %in% names(data)))) { + if (!all(c("xmin", "xmax") %in% names(data))) { data$xmin <- data$x data$xmax <- data$x } @@ -49,7 +49,7 @@ collide <- function(data, width = NULL, name, strategy, intervals <- intervals[!is.na(intervals)] if (vec_unique_count(intervals) > 1 & any(diff(scale(intervals)) < -1e-6)) { - cli::cli_warn("{.fn {name}} requires non-overlapping {.field x} intervals") + cli::cli_warn("{.fn {name}} requires non-overlapping {.field x} intervals.") # This is where the algorithm from [L. Wilkinson. Dot plots. # The American Statistician, 1999.] should be used } @@ -61,7 +61,7 @@ collide <- function(data, width = NULL, name, strategy, data <- dapply(data, "xmin", strategy, ..., width = width) data$y <- data$ymax } else { - cli::cli_abort("Neither {.field y} nor {.field ymax} defined") + cli::cli_abort("{.field y} and {.field ymax} are undefined.") } data[match(seq_along(ord), ord), ] } diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index 937da31298..8aadb2baf0 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -48,9 +48,13 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, data <- flip_data(data, flipped_aes) width <- self$jitter.width %||% (resolution(data$x, zero = FALSE) * 0.4) # Adjust the x transformation based on the number of 'dodge' variables - dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) + possible_dodge <- c("fill", "colour", "linetype", "shape", "size", "alpha") + dodgecols <- intersect(possible_dodge, colnames(data)) if (length(dodgecols) == 0) { - cli::cli_abort("{.fn position_jitterdodge} requires at least one aesthetic to dodge by") + cli::cli_abort(c( + "{.fn position_jitterdodge} requires at least one aesthetic to dodge by.", + i = "Use one of {.or {.val {possible_dodge}}} aesthetics." + )) } ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers ndodge <- vec_unique_count(unlist(ndodge)) diff --git a/R/position-stack.R b/R/position-stack.R index 7be91d3abf..2aacb638bb 100644 --- a/R/position-stack.R +++ b/R/position-stack.R @@ -202,7 +202,7 @@ PositionStack <- ggproto("PositionStack", Position, reverse = params$reverse ) } - if (any(!negative)) { + if (!all(negative)) { pos <- collide(pos, NULL, "position_stack", pos_stack, vjust = params$vjust, fill = params$fill, diff --git a/R/save.R b/R/save.R index e4f7398155..c35a969cd5 100644 --- a/R/save.R +++ b/R/save.R @@ -171,14 +171,12 @@ check_path <- function(path, filename, create.dir, #' @noRd parse_dpi <- function(dpi, call = caller_env()) { if (is_scalar_character(dpi)) { + arg_match0(dpi, c("screen", "print", "retina"), error_call = call) + switch(dpi, screen = 72, print = 300, retina = 320, - cli::cli_abort(c( - "Unknown {.arg dpi} string", - "i" = "Use either {.val screen}, {.val print}, or {.val retina}" - ), call = call) ) } else if (is_scalar_numeric(dpi)) { dpi @@ -290,7 +288,10 @@ plot_dev <- function(device, filename = NULL, dpi = 300, call = caller_env()) { if (is.null(device)) { device <- to_lower_ascii(tools::file_ext(filename)) if (identical(device, "")) { - cli::cli_abort("{.arg filename} has no file extension and {.arg device} is {.val NULL}.", call = call) + cli::cli_abort(c( + "Can't save to {filename}.", + i = "Either supply {.arg filename} with a file extension or supply {.arg device}."), + call = call) } } diff --git a/R/scale-.R b/R/scale-.R index f49fb8e2c7..f559dbb37d 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -573,7 +573,7 @@ check_breaks_labels <- function(breaks, labels, call = NULL) { length(breaks) != length(labels) if (bad_labels) { cli::cli_abort( - "{.arg breaks} and {.arg labels} must have the same length", + "{.arg breaks} and {.arg labels} must have the same length.", call = call ) } @@ -614,7 +614,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # Intercept error here to give examples and mention scale in call if (is.factor(x) || !typeof(x) %in% c("integer", "double")) { cli::cli_abort( - c("Discrete values supplied to continuous scale", + c("Discrete values supplied to continuous scale.", i = "Example values: {.and {.val {head(x, 5)}}}"), call = self$call ) @@ -686,7 +686,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -732,7 +732,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$minor_breaks, NA)) { cli::cli_abort( - "Invalid {.arg minor_breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg minor_breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -768,7 +768,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -783,7 +783,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (length(labels) != length(breaks)) { cli::cli_abort( - "{.arg breaks} and {.arg labels} are different lengths.", + "{.arg breaks} and {.arg labels} have different lengths.", call = self$call ) } @@ -874,7 +874,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, # Intercept error here to give examples and mention scale in call if (!is.discrete(x)) { cli::cli_abort( - c("Continuous values supplied to discrete scale", + c("Continuous values supplied to discrete scale.", i = "Example values: {.and {.val {head(x, 5)}}}"), call = self$call ) @@ -938,7 +938,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -973,7 +973,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } @@ -1133,7 +1133,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, return(NULL) } else if (identical(self$breaks, NA)) { cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } else if (is.waive(self$breaks)) { @@ -1222,7 +1222,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, return(NULL) } else if (identical(self$labels, NA)) { cli::cli_abort( - "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) } else if (is.waive(self$labels)) { @@ -1234,7 +1234,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } if (length(labels) != length(breaks)) { cli::cli_abort( - "{.arg breaks} and {.arg labels} are different lengths.", + "{.arg breaks} and {.arg labels} have different lengths.", call = self$call ) } diff --git a/R/scale-colour.R b/R/scale-colour.R index a3084ec7df..2831e51ade 100644 --- a/R/scale-colour.R +++ b/R/scale-colour.R @@ -93,7 +93,7 @@ scale_colour_continuous <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -118,7 +118,7 @@ scale_fill_continuous <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -151,7 +151,7 @@ scale_colour_binned <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -185,7 +185,7 @@ scale_fill_binned <- function(..., } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", - "i" = "Use either {.val gradient} or {.val viridis}" + "i" = "Use either {.val gradient} or {.val viridis}." )) } } @@ -204,7 +204,7 @@ check_scale_type <- function(scale, name, aesthetic, scale_is_discrete = FALSE, if (!isTRUE(aesthetic %in% scale$aesthetics)) { cli::cli_abort(c( "The {.arg type} argument must return a continuous scale for the {.field {aesthetic}} aesthetic.", - "x" = "The provided scale works with the following aesthetics: {.field {scale$aesthetics}}" + "x" = "The provided scale works with the following aesthetics: {.field {scale$aesthetics}}." ), call = call) } if (isTRUE(scale$is_discrete()) != scale_is_discrete) { diff --git a/R/scale-expansion.R b/R/scale-expansion.R index abba246226..5518e9f012 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -37,7 +37,7 @@ #' expansion <- function(mult = 0, add = 0) { if (!(is.numeric(mult) && (length(mult) %in% 1:2) && is.numeric(add) && (length(add) %in% 1:2))) { - cli::cli_abort("{.arg mult} and {.arg add} must be numeric vectors with 1 or 2 elements") + cli::cli_abort("{.arg mult} and {.arg add} must be numeric vectors with 1 or 2 elements.") } mult <- rep(mult, length.out = 2) @@ -66,7 +66,7 @@ expand_scale <- function(mult = 0, add = 0) { #' expand_range4 <- function(limits, expand) { if (!(is.numeric(expand) && length(expand) %in% c(2,4))) { - cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements") + cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements.") } if (all(!is.finite(limits))) { diff --git a/R/scale-hue.R b/R/scale-hue.R index fe8545dc76..64ca050e53 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -188,7 +188,7 @@ pal_qualitative <- function(type, h, c, l, h.start, direction) { function(n) { type_list <- if (!is.list(type)) list(type) else type if (!all(vapply(type_list, is.character, logical(1)))) { - cli::cli_abort("{.arg type} must be a character vector or a list of character vectors") + cli::cli_abort("{.arg type} must be a character vector or a list of character vectors.") } type_lengths <- lengths(type_list) # If there are more levels than color codes default to pal_hue() diff --git a/R/scale-linetype.R b/R/scale-linetype.R index d3bc3b6e87..bf382c985a 100644 --- a/R/scale-linetype.R +++ b/R/scale-linetype.R @@ -48,8 +48,8 @@ scale_linetype_binned <- function(..., na.value = "blank") { #' @export scale_linetype_continuous <- function(...) { cli::cli_abort(c( - "A continuous variable cannot be mapped to the {.field linetype} aesthetic", - "i" = "choose a different aesthetic or use {.fn scale_linetype_binned}" + "A continuous variable cannot be mapped to the {.field linetype} aesthetic.", + "i" = "Choose a different aesthetic or use {.fn scale_linetype_binned}." )) } #' @rdname scale_linetype diff --git a/R/scale-shape.R b/R/scale-shape.R index 8d3ef30ef1..4942ebbdef 100644 --- a/R/scale-shape.R +++ b/R/scale-shape.R @@ -70,7 +70,7 @@ scale_shape_ordinal <- function(...) { #' @usage NULL scale_shape_continuous <- function(...) { cli::cli_abort(c( - "A continuous variable cannot be mapped to the {.field shape} aesthetic", - "i" = "choose a different aesthetic or use {.fn scale_shape_binned}" + "A continuous variable cannot be mapped to the {.field shape} aesthetic.", + "i" = "Choose a different aesthetic or use {.fn scale_shape_binned}." )) } diff --git a/R/scale-view.R b/R/scale-view.R index 6de692abfe..34af3181d8 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -98,8 +98,8 @@ view_scale_empty <- function() { get_breaks = function() NULL, get_breaks_minor = function() NULL, get_labels = function(breaks = NULL) breaks, - rescale = function(x) cli::cli_abort("Not implemented"), - map = function(x) cli::cli_abort("Not implemented"), + rescale = function(x) cli::cli_abort("Not implemented."), + map = function(x) cli::cli_abort("Not implemented."), make_title = function(title) title, break_positions = function() NULL, break_positions_minor = function() NULL diff --git a/R/stat-.R b/R/stat-.R index 2a87f4197c..33b59391ef 100644 --- a/R/stat-.R +++ b/R/stat-.R @@ -105,7 +105,7 @@ Stat <- ggproto("Stat", try_fetch( inject(self$compute_panel(data = data, scales = scales, !!!params)), error = function(cnd) { - cli::cli_warn("Computation failed in {.fn {snake_class(self)}}", parent = cnd) + cli::cli_warn("Computation failed in {.fn {snake_class(self)}}.", parent = cnd) data_frame0() } ) @@ -166,7 +166,7 @@ Stat <- ggproto("Stat", dropped <- non_constant_columns[!non_constant_columns %in% self$dropped_aes] if (length(dropped) > 0) { cli::cli_warn(c( - "The following aesthetics were dropped during statistical transformation: {.field {glue_collapse(dropped, sep = ', ')}}", + "The following aesthetics were dropped during statistical transformation: {.field {dropped}}.", "i" = "This can happen when ggplot fails to infer the correct grouping structure in the data.", "i" = "Did you forget to specify a {.code group} aesthetic or to convert a numerical variable into a factor?" )) @@ -178,7 +178,7 @@ Stat <- ggproto("Stat", }, compute_group = function(self, data, scales) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, finish_layer = function(self, data, params) { diff --git a/R/stat-bin.R b/R/stat-bin.R index 04cbc30ce0..4f35d83a84 100644 --- a/R/stat-bin.R +++ b/R/stat-bin.R @@ -103,7 +103,7 @@ StatBin <- ggproto("StatBin", Stat, x <- flipped_names(params$flipped_aes)$x if (is_mapped_discrete(data[[x]])) { cli::cli_abort(c( - "{.fn {snake_class(self)}} requires a continuous {.field {x}} aesthetic", + "{.fn {snake_class(self)}} requires a continuous {.field {x}} aesthetic.", "x" = "the {.field {x}} aesthetic is discrete.", "i" = "Perhaps you want {.code stat=\"count\"}?" )) diff --git a/R/stat-density-2d.R b/R/stat-density-2d.R index 0569acc20a..3fd6cf60ee 100644 --- a/R/stat-density-2d.R +++ b/R/stat-density-2d.R @@ -146,12 +146,10 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, # set up data and parameters for contouring contour_var <- params$contour_var %||% "density" - if (!isTRUE(contour_var %in% c("density", "ndensity", "count"))) { - cli::cli_abort(c( - "Invalid value of {.arg contour_var} ({.val {contour_var}})", - "i" = "Supported values are {.val density}, {.val ndensity}, and {.val count}." - )) - } + arg_match0( + contour_var, + c("density", "ndensity", "count") + ) data$z <- data[[contour_var]] z.range <- range(data$z, na.rm = TRUE, finite = TRUE) params <- params[intersect(names(params), c("bins", "binwidth", "breaks"))] @@ -170,7 +168,7 @@ StatDensity2d <- ggproto("StatDensity2d", Stat, try_fetch( inject(contour_stat$compute_panel(data = data, scales = scales, !!!params)), error = function(cnd) { - cli::cli_warn("Computation failed in {.fn {snake_class(self)}}", parent = cnd) + cli::cli_warn("Computation failed in {.fn {snake_class(self)}}.", parent = cnd) data_frame0() } ) diff --git a/R/stat-density.R b/R/stat-density.R index b075952886..4bf28f797b 100644 --- a/R/stat-density.R +++ b/R/stat-density.R @@ -167,7 +167,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, fit_data_to_bounds <- function(bounds, x, w) { is_inside_bounds <- (bounds[1] <= x) & (x <= bounds[2]) - if (any(!is_inside_bounds)) { + if (!all(is_inside_bounds)) { cli::cli_warn("Some data points are outside of `bounds`. Removing them.") x <- x[is_inside_bounds] w <- w[is_inside_bounds] diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index 8e763bbdcd..67b0da407d 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -66,7 +66,7 @@ StatQqLine <- ggproto("StatQqLine", Stat, if (is.null(quantiles)) { quantiles <- stats::ppoints(n) } else if (length(quantiles) != n) { - cli::cli_abort("{.arg quantiles} must have the same length as the data") + cli::cli_abort("{.arg quantiles} must have the same length as the data.") } theoretical <- inject(distribution(p = quantiles, !!!dparams)) diff --git a/R/stat-qq.R b/R/stat-qq.R index e1ea8c66cf..dc3762dacd 100644 --- a/R/stat-qq.R +++ b/R/stat-qq.R @@ -95,7 +95,7 @@ StatQq <- ggproto("StatQq", Stat, if (is.null(quantiles)) { quantiles <- stats::ppoints(n) } else if (length(quantiles) != n) { - cli::cli_abort("The length of {.arg quantiles} must match the length of the data") + cli::cli_abort("The length of {.arg quantiles} must match the length of the data.") } theoretical <- inject(distribution(p = quantiles, !!!dparams)) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 6156922883..4eadd8ca58 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -155,7 +155,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, calc_bw <- function(x, bw) { if (is.character(bw)) { if (length(x) < 2) { - cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically") + cli::cli_abort("{.arg x} must contain at least 2 elements to select a bandwidth automatically.") } bw <- switch( @@ -167,7 +167,7 @@ calc_bw <- function(x, bw) { sj = , `sj-ste` = stats::bw.SJ(x, method = "ste"), `sj-dpi` = stats::bw.SJ(x, method = "dpi"), - cli::cli_abort("{.var {bw}} is not a valid bandwidth rule") + cli::cli_abort("{.var {bw}} is not a valid bandwidth rule.") ) } bw diff --git a/R/theme.R b/R/theme.R index 1774a23e08..70a5f8c7a6 100644 --- a/R/theme.R +++ b/R/theme.R @@ -545,7 +545,7 @@ add_theme <- function(t1, t2, t2name, call = caller_env()) { t1[item] <- list(x) }, error = function(cnd) { - cli::cli_abort("Problem merging the {.var {item}} theme element", parent = cnd, call = call) + cli::cli_abort("Can't merge the {.var {item}} theme element.", parent = cnd, call = call) } ) @@ -585,7 +585,7 @@ add_theme <- function(t1, t2, t2name, call = caller_env()) { #' t$text calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, call = caller_env()) { - if (verbose) message(element, " --> ", appendLF = FALSE) + if (verbose) cli::cli_inform(paste0(element, " --> ")) el_out <- theme[[element]] @@ -595,7 +595,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, if (isTRUE(skip_blank)) { el_out <- NULL } else { - if (verbose) message("element_blank (no inheritance)") + if (verbose) cli::cli_inform("{.fn element_blank} (no inheritance)") return(el_out) } } @@ -607,7 +607,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, # it is of the class specified in element_tree if (!is.null(el_out) && !inherits(el_out, element_tree[[element]]$class)) { - cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}", call = call) + cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}.", call = call) } # Get the names of parents from the inheritance tree @@ -615,7 +615,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, # If no parents, this is a "root" node. Just return this element. if (is.null(pnames)) { - if (verbose) message("nothing (top level)") + if (verbose) cli::cli_inform("nothing (top level)") # Check that all the properties of this element are non-NULL nullprops <- vapply(el_out, is.null, logical(1)) @@ -630,11 +630,11 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE, return(el_out) # no null properties remaining, return element } - cli::cli_abort("Theme element {.var {element}} has {.val NULL} property without default: {.field {names(nullprops)[nullprops]}}", call = call) + cli::cli_abort("Theme element {.var {element}} has {.code NULL} property without default: {.field {names(nullprops)[nullprops]}}.", call = call) } # Calculate the parent objects' inheritance - if (verbose) message(paste(pnames, collapse = ", ")) + if (verbose) cli::cli_inform("{pnames}") parents <- lapply( pnames, calc_element, @@ -686,7 +686,7 @@ merge_element.default <- function(new, old) { } # otherwise we can't merge - cli::cli_abort("No method for merging {.cls {class(new)[1]}} into {.cls {class(old)[1]}}") + cli::cli_abort("No method for merging {.cls {class(new)[1]}} into {.cls {class(old)[1]}}.") } #' @rdname merge_element @@ -706,7 +706,7 @@ merge_element.element <- function(new, old) { # actual merging can only happen if classes match if (!inherits(new, class(old)[1])) { - cli::cli_abort("Only elements of the same class can be merged") + cli::cli_abort("Only elements of the same class can be merged.") } # Override NULL properties of new with the values in old diff --git a/R/utilities-break.R b/R/utilities-break.R index c809a940b5..1bcce62ec3 100644 --- a/R/utilities-break.R +++ b/R/utilities-break.R @@ -95,7 +95,7 @@ find_origin <- function(x_range, width, boundary) { breaks <- function(x, equal, nbins = NULL, binwidth = NULL) { equal <- arg_match0(equal, c("numbers", "width")) if ((!is.null(nbins) && !is.null(binwidth)) || (is.null(nbins) && is.null(binwidth))) { - cli::cli_abort("Specify exactly one of {.arg n} and {.arg width}") + cli::cli_abort("Specify exactly one of {.arg n} and {.arg width}.") } rng <- range(x, na.rm = TRUE, finite = TRUE) diff --git a/R/utilities.R b/R/utilities.R index ad831790d3..b16540d9c5 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -42,7 +42,7 @@ check_required_aesthetics <- function(required, present, name, call = caller_env if (length(missing_aes) > 1) { message <- paste0(message, " {.strong or} {.field {missing_aes[[2]]}}") } - cli::cli_abort(message, call = call) + cli::cli_abort(paste0(message, "."), call = call) } # Concatenate a named list for output @@ -62,7 +62,7 @@ clist <- function(l) { # @keyword internal uniquecols <- function(df) { df <- df[1, sapply(df, is_unique), drop = FALSE] - rownames(df) <- 1:nrow(df) + rownames(df) <- seq_len(nrow(df)) df } @@ -199,7 +199,7 @@ gg_dep <- function(version, msg) { .Deprecated() v <- as.package_version(version) cv <- utils::packageVersion("ggplot2") - text <- "{msg} (Defunct; last used in version {version})" + text <- "{msg} (Defunct; last used in version {version})." # If current major number is greater than last-good major number, or if # current minor number is more than 1 greater than last-good minor number, diff --git a/R/zzz.R b/R/zzz.R index 0dcfd407cf..4d6755b53b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,11 +11,11 @@ random_tip <- function() { tips <- c( "RStudio Community is a great place to get help: https://community.rstudio.com/c/tidyverse", "Learn more about the underlying theory at https://ggplot2-book.org/", - "Keep up to date with changes at https://www.tidyverse.org/blog/", + "Keep up to date with changes at https://tidyverse.org/blog/", "Use suppressPackageStartupMessages() to eliminate package startup messages", "Need help? Try Stackoverflow: https://stackoverflow.com/tags/ggplot2", "Need help getting started? Try the R Graphics Cookbook: https://r-graphics.org", - "Want to understand how all the pieces fit together? Read R for Data Science: https://r4ds.had.co.nz/" + "Want to understand how all the pieces fit together? Read R for Data Science: https://r4ds.hadley.nz/" ) sample(tips, 1) diff --git a/man/annotate.Rd b/man/annotate.Rd index 63e29580cf..a282c9eb09 100644 --- a/man/annotate.Rd +++ b/man/annotate.Rd @@ -48,7 +48,7 @@ affect the legend. \section{Unsupported geoms}{ Due to their special nature, reference line geoms \code{\link[=geom_abline]{geom_abline()}}, -\code{\link[=geom_hline]{geom_hline()}}, and \code{\link[=geom_vline]{geom_vline()}} can't be used with \code{\link[=annotate]{annotate()}}. +\code{\link[=geom_hline]{geom_hline()}}, and \code{\link[=geom_vline]{geom_vline()}} can't be used with \code{annotate()}. You can use these geoms directly for annotations. } diff --git a/tests/testthat/_snaps/aes.md b/tests/testthat/_snaps/aes.md index 356b8fdc19..7f7f3ddc89 100644 --- a/tests/testthat/_snaps/aes.md +++ b/tests/testthat/_snaps/aes.md @@ -12,7 +12,7 @@ # alternative_aes_extract_usage() can inspect the call - Don't know how to get alternative usage for `foo` + Don't know how to get alternative usage for `foo`. # new_aes() checks its inputs diff --git a/tests/testthat/_snaps/annotate.md b/tests/testthat/_snaps/annotate.md index 22f7005c0a..d453866100 100644 --- a/tests/testthat/_snaps/annotate.md +++ b/tests/testthat/_snaps/annotate.md @@ -3,14 +3,14 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `annotation_raster()` only works with `coord_cartesian()` + ! `annotation_raster()` only works with `coord_cartesian()`. --- Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `annotation_custom()` only works with `coord_cartesian()` + ! `annotation_custom()` only works with `coord_cartesian()`. # annotation_map() checks the input data @@ -18,7 +18,7 @@ --- - `map` must have the columns `x`, `y`, and `id` + `map` must have the columns `x`, `y`, and `id`. # unsupported geoms signal a warning (#4719) diff --git a/tests/testthat/_snaps/autolayer.md b/tests/testthat/_snaps/autolayer.md index cb27e7aebc..23fea920ca 100644 --- a/tests/testthat/_snaps/autolayer.md +++ b/tests/testthat/_snaps/autolayer.md @@ -1,4 +1,4 @@ # autolayers default error looks correct - No autolayer method available for objects + No autolayer method available for objects. diff --git a/tests/testthat/_snaps/autoplot.md b/tests/testthat/_snaps/autoplot.md index 37dc7f4163..5f872f476f 100644 --- a/tests/testthat/_snaps/autoplot.md +++ b/tests/testthat/_snaps/autoplot.md @@ -1,5 +1,5 @@ # autoplot throws helpful error on default Objects of class are not supported by autoplot. - i have you loaded the required package? + i Have you loaded the required package? diff --git a/tests/testthat/_snaps/compat-plyr.md b/tests/testthat/_snaps/compat-plyr.md index 83f3ac29fb..d31d586cc8 100644 --- a/tests/testthat/_snaps/compat-plyr.md +++ b/tests/testthat/_snaps/compat-plyr.md @@ -1,6 +1,6 @@ # input checks work in compat functions - Can only remove rownames from and objects + Can only remove rownames from and objects. --- @@ -8,7 +8,7 @@ --- - Must be a character vector, call, or formula + Must be a character vector, call, or formula. --- diff --git a/tests/testthat/_snaps/coord-.md b/tests/testthat/_snaps/coord-.md index cf2c6984c2..c4f74d626c 100644 --- a/tests/testthat/_snaps/coord-.md +++ b/tests/testthat/_snaps/coord-.md @@ -1,20 +1,20 @@ # Coord errors on missing methods - `coord()` has not implemented a `render_bg()` method + `coord()` has not implemented a `render_bg()` method. --- - `coord()` has not implemented a `render_axis_h()` method + `coord()` has not implemented a `render_axis_h()` method. --- - `coord()` has not implemented a `render_axis_v()` method + `coord()` has not implemented a `render_axis_v()` method. --- - `coord()` has not implemented a `backtransform_range()` method + `coord()` has not implemented a `backtransform_range()` method. --- - `coord()` has not implemented a `range()` method + `coord()` has not implemented a `range()` method. diff --git a/tests/testthat/_snaps/coord_sf.md b/tests/testthat/_snaps/coord_sf.md index c53025f074..486763d781 100644 --- a/tests/testthat/_snaps/coord_sf.md +++ b/tests/testthat/_snaps/coord_sf.md @@ -1,10 +1,10 @@ # axis labels can be set manually - Breaks and labels along x direction are different lengths + `breaks` and `labels` along `x` direction have different lengths. --- - Breaks and labels along y direction are different lengths + `breaks` and `labels` along `y` direction have different lengths. --- @@ -16,7 +16,7 @@ # default crs works - Scale limits cannot be mapped onto spatial coordinates in `coord_sf()` + Scale limits cannot be mapped onto spatial coordinates in `coord_sf()`. i Consider setting `lims_method = "geometry_bbox"` or `default_crs = NULL`. # coord_sf() throws error when limits are badly specified diff --git a/tests/testthat/_snaps/error.md b/tests/testthat/_snaps/error.md index c3f91fd3df..a8cb5172df 100644 --- a/tests/testthat/_snaps/error.md +++ b/tests/testthat/_snaps/error.md @@ -1,10 +1,10 @@ # various misuses of +.gg (#2638) - Cannot use `+` with a single argument + Cannot use `+` with a single argument. i Did you accidentally put `+` on a new line? --- - Cannot add objects together + Cannot add objects together. i Did you forget to add this object to a object? diff --git a/tests/testthat/_snaps/facet-.md b/tests/testthat/_snaps/facet-.md index 3fda69b2c6..2efa86bc64 100644 --- a/tests/testthat/_snaps/facet-.md +++ b/tests/testthat/_snaps/facet-.md @@ -1,6 +1,6 @@ # facet_grid() fails if passed both a formula and a vars() - `rows` must be "NULL" or a `vars()` list if `cols` is a `vars()` list + `rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list. # can't pass formulas to `cols` @@ -13,12 +13,12 @@ --- - `rows` must be "NULL" or a `vars()` list if `cols` is a `vars()` list + `rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list. i Did you use `%>%` or `|>` instead of `+`? --- - A grid facet specification can't have more than two dimensions + A grid facet specification can't have more than two dimensions. --- @@ -38,18 +38,18 @@ --- - Faceting variables must have at least one value + Faceting variables must have at least one value. # validate_facets() provide meaningful errors - Please use `vars()` to supply facet variables + Please use `vars()` to supply facet variables. --- - Please use `vars()` to supply facet variables + Please use `vars()` to supply facet variables. i Did you use `%>%` or `|>` instead of `+`? # check_layout() throws meaningful errors - Facet layout has a bad format. It must contain columns `PANEL`, `SCALE_X`, and `SCALE_Y` + Facet layout has a bad format. It must contain columns `PANEL`, `SCALE_X`, and `SCALE_Y`. diff --git a/tests/testthat/_snaps/facet-layout.md b/tests/testthat/_snaps/facet-layout.md index d45f2c1f7d..03cdcbe8b3 100644 --- a/tests/testthat/_snaps/facet-layout.md +++ b/tests/testthat/_snaps/facet-layout.md @@ -24,33 +24,33 @@ --- - Need 3 panels, but together `nrow` and `ncol` only provide 1 - i Please increase `ncol` and/or `nrow` + Need 3 panels, but together `nrow` and `ncol` only provide 1. + i Please increase `ncol` and/or `nrow`. --- - `facet_wrap()` can't use free scales with `coord_fixed()` + `facet_wrap()` can't use free scales with `coord_fixed()`. # facet_grid throws errors at bad layout specs - `coord_fixed()` doesn't support free scales + `coord_fixed()` doesn't support free scales. --- - Free scales cannot be mixed with a fixed aspect ratio + Free scales cannot be mixed with a fixed aspect ratio. # facet_wrap and facet_grid throws errors when using reserved words - "ROW" is not an allowed name for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" is not an allowed name for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". --- - "ROW" and "PANEL" are not allowed names for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" and "PANEL" are not allowed names for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". --- - "ROW" is not an allowed name for faceting variables - i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y" + "ROW" is not an allowed name for faceting variables. + i Change the name of your data columns to not be "PANEL", "ROW", "COL", "SCALE_X", or "SCALE_Y". diff --git a/tests/testthat/_snaps/facet-strips.md b/tests/testthat/_snaps/facet-strips.md index 2bc6ad8d09..e6a72d047c 100644 --- a/tests/testthat/_snaps/facet-strips.md +++ b/tests/testthat/_snaps/facet-strips.md @@ -1,4 +1,4 @@ # facet_grid() warns about bad switch input - `switch` must be either "both", "x", or "y" + `switch` must be one of "both", "x", or "y", not "z". diff --git a/tests/testthat/_snaps/geom-.md b/tests/testthat/_snaps/geom-.md index 46be5c85c3..0eae2d74ba 100644 --- a/tests/testthat/_snaps/geom-.md +++ b/tests/testthat/_snaps/geom-.md @@ -10,6 +10,6 @@ --- - Aesthetics must be either length 1 or the same as the data (4) - x Fix the following mappings: `d` and `e` + Aesthetics must be either length 1 or the same as the data (4). + x Fix the following mappings: `d` and `e`. diff --git a/tests/testthat/_snaps/geom-boxplot.md b/tests/testthat/_snaps/geom-boxplot.md index 6ae492646a..d50a9db5e9 100644 --- a/tests/testthat/_snaps/geom-boxplot.md +++ b/tests/testthat/_snaps/geom-boxplot.md @@ -1,5 +1,5 @@ # boxplots with a group size >1 error - Can only draw one boxplot per group + Can only draw one boxplot per group. i Did you forget `aes(group = ...)`? diff --git a/tests/testthat/_snaps/geom-dotplot.md b/tests/testthat/_snaps/geom-dotplot.md index 859bad859c..ba2fa8558c 100644 --- a/tests/testthat/_snaps/geom-dotplot.md +++ b/tests/testthat/_snaps/geom-dotplot.md @@ -4,13 +4,13 @@ # weight aesthetic is checked - Computation failed in `stat_bindot()` + Computation failed in `stat_bindot()`. Caused by error in `compute_group()`: ! `weight` must be nonnegative integers, not a double vector. --- - Computation failed in `stat_bindot()` + Computation failed in `stat_bindot()`. Caused by error in `compute_group()`: ! `weight` must be nonnegative integers, not a double vector. diff --git a/tests/testthat/_snaps/geom-jitter.md b/tests/testthat/_snaps/geom-jitter.md index 972ddc90e0..ee198b595c 100644 --- a/tests/testthat/_snaps/geom-jitter.md +++ b/tests/testthat/_snaps/geom-jitter.md @@ -1,5 +1,5 @@ # geom_jitter() throws relevant errors - both `position` and `width`/`height` are supplied - i Only use one approach to alter the position + Both `position` and `width`/`height` were supplied. + i Choose a single approach to alter the position. diff --git a/tests/testthat/_snaps/geom-label.md b/tests/testthat/_snaps/geom-label.md index 73fcb48b0e..2ea8c33c06 100644 --- a/tests/testthat/_snaps/geom-label.md +++ b/tests/testthat/_snaps/geom-label.md @@ -1,9 +1,9 @@ # geom_label() throws meaningful errors - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Choose one approach to alter the position. --- - `label` must be of length 1 + `label` must be of length 1. diff --git a/tests/testthat/_snaps/geom-linerange.md b/tests/testthat/_snaps/geom-linerange.md index 840ed7d604..8fb6cc7daa 100644 --- a/tests/testthat/_snaps/geom-linerange.md +++ b/tests/testthat/_snaps/geom-linerange.md @@ -3,5 +3,5 @@ Problem while setting up geom. i Error occurred in the 1st layer. Caused by error in `compute_geom_1()`: - ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax + ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax. diff --git a/tests/testthat/_snaps/geom-map.md b/tests/testthat/_snaps/geom-map.md index f669e05c9d..03bef91fa5 100644 --- a/tests/testthat/_snaps/geom-map.md +++ b/tests/testthat/_snaps/geom-map.md @@ -4,5 +4,5 @@ --- - `map` must have the columns `x`, `y`, and `id` + `map` must have the columns `x`, `y`, and `id`. diff --git a/tests/testthat/_snaps/geom-path.md b/tests/testthat/_snaps/geom-path.md index e5c4d0eb4f..6516134f98 100644 --- a/tests/testthat/_snaps/geom-path.md +++ b/tests/testthat/_snaps/geom-path.md @@ -3,5 +3,5 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_path()` can't have varying colour, linewidth, and/or alpha along the line when linetype isn't solid + ! `geom_path()` can't have varying colour, linewidth, and/or alpha along the line when linetype isn't solid. diff --git a/tests/testthat/_snaps/geom-point.md b/tests/testthat/_snaps/geom-point.md index c5baaefa2a..e50798c2f5 100644 --- a/tests/testthat/_snaps/geom-point.md +++ b/tests/testthat/_snaps/geom-point.md @@ -1,9 +1,9 @@ # invalid shape names raise an error - Shape aesthetic contains invalid value: "void" + Shape aesthetic contains invalid value: "void". --- - shape names must be given unambiguously - i Fix "tri" + Shape names must be given unambiguously. + i Fix "tri". diff --git a/tests/testthat/_snaps/geom-raster.md b/tests/testthat/_snaps/geom-raster.md index 3458e9971b..90bdd9dc0b 100644 --- a/tests/testthat/_snaps/geom-raster.md +++ b/tests/testthat/_snaps/geom-raster.md @@ -19,5 +19,5 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_raster()` only works with `coord_cartesian()` + ! `geom_raster()` only works with `coord_cartesian()`. diff --git a/tests/testthat/_snaps/geom-ribbon.md b/tests/testthat/_snaps/geom-ribbon.md index af4c34752f..ae45d533f0 100644 --- a/tests/testthat/_snaps/geom-ribbon.md +++ b/tests/testthat/_snaps/geom-ribbon.md @@ -17,7 +17,7 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! Aesthetics can not vary along a ribbon + ! Aesthetics can not vary along a ribbon. --- diff --git a/tests/testthat/_snaps/geom-sf.md b/tests/testthat/_snaps/geom-sf.md index b65a327f8a..1cc4fbb7d1 100644 --- a/tests/testthat/_snaps/geom-sf.md +++ b/tests/testthat/_snaps/geom-sf.md @@ -3,15 +3,19 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_panel()`: - ! `geom_sf()` can only be used with `coord_sf()` + ! `geom_sf()` can only be used with `coord_sf()`. --- - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. --- - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. + +--- + + Removed 1 row containing missing values or values outside the scale range (`geom_sf()`). diff --git a/tests/testthat/_snaps/geom-text.md b/tests/testthat/_snaps/geom-text.md index 7c49514b8b..c9d11b2bc7 100644 --- a/tests/testthat/_snaps/geom-text.md +++ b/tests/testthat/_snaps/geom-text.md @@ -1,5 +1,5 @@ # geom_text() checks input - both `position` and `nudge_x`/`nudge_y` are supplied - i Only use one approach to alter the position + Both `position` and `nudge_x`/`nudge_y` are supplied. + i Only use one approach to alter the position. diff --git a/tests/testthat/_snaps/geom-violin.md b/tests/testthat/_snaps/geom-violin.md index fff4046b0d..80da5aad02 100644 --- a/tests/testthat/_snaps/geom-violin.md +++ b/tests/testthat/_snaps/geom-violin.md @@ -3,12 +3,12 @@ Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! `draw_quantiles` must be between 0 and 1 + ! `draw_quantiles` must be between 0 and 1. --- Problem while converting geom to grob. i Error occurred in the 1st layer. Caused by error in `draw_group()`: - ! `draw_quantiles` must be between 0 and 1 + ! `draw_quantiles` must be between 0 and 1. diff --git a/tests/testthat/_snaps/ggsave.md b/tests/testthat/_snaps/ggsave.md index 97cf92d361..8a16fc672b 100644 --- a/tests/testthat/_snaps/ggsave.md +++ b/tests/testthat/_snaps/ggsave.md @@ -4,8 +4,7 @@ # invalid single-string DPI values throw an error - Unknown `dpi` string - i Use either "screen", "print", or "retina" + `dpi` must be one of "screen", "print", or "retina", not "abc". # invalid non-single-string DPI values throw an error diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index 6e49237a76..3703c52d09 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -40,7 +40,7 @@ --- - `nrow` * `ncol` needs to be larger than the number of breaks (5) + `nrow` * `ncol` needs to be larger than the number of breaks (5). # colorsteps and bins checks the breaks format diff --git a/tests/testthat/_snaps/labellers.md b/tests/testthat/_snaps/labellers.md index 667fc9aa8c..8887717d9d 100644 --- a/tests/testthat/_snaps/labellers.md +++ b/tests/testthat/_snaps/labellers.md @@ -1,12 +1,12 @@ # resolve_labeller() provide meaningful errors - Supply one of `rows` or `cols` + Supply one of `rows` or `cols`. --- - Cannot supply both `rows` and `cols` to `facet_wrap()` + Cannot supply both `rows` and `cols` to `facet_wrap()`. # labeller function catches overlap in names - Conflict between `.rows` and `vs` + Conflict between `.rows` and `vs`. diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md index 641c3d3dc3..fc9cabc49a 100644 --- a/tests/testthat/_snaps/layer.md +++ b/tests/testthat/_snaps/layer.md @@ -12,16 +12,16 @@ --- - `mapping` must be created by `aes()` + `mapping` must be created by `aes()`. --- - `mapping` must be created by `aes()` + `mapping` must be created by `aes()`. i Did you use `%>%` or `|>` instead of `+`? --- - Can't find geom called "test" + Can't find geom called "test". --- @@ -74,14 +74,14 @@ Problem while setting up geom. i Error occurred in the 1st layer. Caused by error in `compute_geom_1()`: - ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax + ! `geom_linerange()` requires the following missing aesthetics: ymax or xmin and xmax. --- Problem while converting geom to grob. i Error occurred in the 2nd layer. Caused by error in `draw_group()`: - ! Can only draw one boxplot per group + ! Can only draw one boxplot per group. i Did you forget `aes(group = ...)`? # layer warns for constant aesthetics @@ -91,5 +91,5 @@ # layer_data returns a data.frame - `layer_data()` must return a + `layer_data()` must return a . diff --git a/tests/testthat/_snaps/limits.md b/tests/testthat/_snaps/limits.md index b5a400b89c..b7f4ffd960 100644 --- a/tests/testthat/_snaps/limits.md +++ b/tests/testthat/_snaps/limits.md @@ -1,8 +1,8 @@ # limits() throw meaningful errors - All arguments must be named + All arguments must be named. --- - `linewidth` must be a two-element vector + `linewidth` must be a two-element vector. diff --git a/tests/testthat/_snaps/plot.md b/tests/testthat/_snaps/plot.md index 6dd7cfd427..6035364389 100644 --- a/tests/testthat/_snaps/plot.md +++ b/tests/testthat/_snaps/plot.md @@ -1,7 +1,7 @@ # ggplot() throws informative errors - `mapping` should be created with `aes()`. - x You've supplied a object + `mapping` must be created with `aes()`. + x You've supplied a character vector. --- @@ -10,12 +10,12 @@ # construction have user friendly errors - Cannot use `+` with a single argument + Cannot use `+` with a single argument. i Did you accidentally put `+` on a new line? --- - Cannot add objects together + Cannot add objects together. i Did you forget to add this object to a object? --- diff --git a/tests/testthat/_snaps/position-collide.md b/tests/testthat/_snaps/position-collide.md index 9f31dc4898..55032f0a58 100644 --- a/tests/testthat/_snaps/position-collide.md +++ b/tests/testthat/_snaps/position-collide.md @@ -1,8 +1,8 @@ # collide() checks the input data - Neither y nor ymax defined + y and ymax are undefined. --- - `test()` requires non-overlapping x intervals + `test()` requires non-overlapping x intervals. diff --git a/tests/testthat/_snaps/position-jitterdodge.md b/tests/testthat/_snaps/position-jitterdodge.md index 068f546f5b..1a387e880e 100644 --- a/tests/testthat/_snaps/position-jitterdodge.md +++ b/tests/testthat/_snaps/position-jitterdodge.md @@ -3,5 +3,6 @@ Problem while computing position. i Error occurred in the 1st layer. Caused by error in `setup_params()`: - ! `position_jitterdodge()` requires at least one aesthetic to dodge by + ! `position_jitterdodge()` requires at least one aesthetic to dodge by. + i Use one of "fill", "colour", "linetype", "shape", "size", or "alpha" aesthetics. diff --git a/tests/testthat/_snaps/scale-colour-continuous.md b/tests/testthat/_snaps/scale-colour-continuous.md index cea6a4ed43..a5410a8799 100644 --- a/tests/testthat/_snaps/scale-colour-continuous.md +++ b/tests/testthat/_snaps/scale-colour-continuous.md @@ -11,7 +11,7 @@ --- The `type` argument must return a continuous scale for the colour aesthetic. - x The provided scale works with the following aesthetics: fill and point_colour + x The provided scale works with the following aesthetics: fill and point_colour. --- @@ -21,10 +21,10 @@ --- Unknown scale type: "abc" - i Use either "gradient" or "viridis" + i Use either "gradient" or "viridis". --- Unknown scale type: "abc" - i Use either "gradient" or "viridis" + i Use either "gradient" or "viridis". diff --git a/tests/testthat/_snaps/scale-discrete.md b/tests/testthat/_snaps/scale-discrete.md index d00d91938b..c668bceba9 100644 --- a/tests/testthat/_snaps/scale-discrete.md +++ b/tests/testthat/_snaps/scale-discrete.md @@ -1,10 +1,10 @@ # Aesthetics with no continuous interpretation fails when called - A continuous variable cannot be mapped to the linetype aesthetic - i choose a different aesthetic or use `scale_linetype_binned()` + A continuous variable cannot be mapped to the linetype aesthetic. + i Choose a different aesthetic or use `scale_linetype_binned()`. --- - A continuous variable cannot be mapped to the shape aesthetic - i choose a different aesthetic or use `scale_shape_binned()` + A continuous variable cannot be mapped to the shape aesthetic. + i Choose a different aesthetic or use `scale_shape_binned()`. diff --git a/tests/testthat/_snaps/scale-expansion.md b/tests/testthat/_snaps/scale-expansion.md index 719559d8f5..41a54fcd6b 100644 --- a/tests/testthat/_snaps/scale-expansion.md +++ b/tests/testthat/_snaps/scale-expansion.md @@ -1,8 +1,8 @@ # expansion() checks input - `mult` and `add` must be numeric vectors with 1 or 2 elements + `mult` and `add` must be numeric vectors with 1 or 2 elements. --- - `mult` and `add` must be numeric vectors with 1 or 2 elements + `mult` and `add` must be numeric vectors with 1 or 2 elements. diff --git a/tests/testthat/_snaps/scale-hue.md b/tests/testthat/_snaps/scale-hue.md index c63e0ec179..bccf63c43a 100644 --- a/tests/testthat/_snaps/scale-hue.md +++ b/tests/testthat/_snaps/scale-hue.md @@ -1,4 +1,4 @@ # scale_hue() checks the type input - `type` must be a character vector or a list of character vectors + `type` must be a character vector or a list of character vectors. diff --git a/tests/testthat/_snaps/scales.md b/tests/testthat/_snaps/scales.md index 0f83d92c63..61754a645a 100644 --- a/tests/testthat/_snaps/scales.md +++ b/tests/testthat/_snaps/scales.md @@ -1,46 +1,46 @@ # scale_apply preserves class and attributes - `scale_id` must not contain any "NA" + `scale_id` must not contain any "NA". # breaks and labels are correctly checked - `breaks` and `labels` must have the same length + `breaks` and `labels` must have the same length. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `minor_breaks` specification. Use "NULL", not "NA". + Invalid `minor_breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - `breaks` and `labels` are different lengths. + `breaks` and `labels` have different lengths. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - Invalid `breaks` specification. Use "NULL", not "NA". + Invalid `breaks` specification. Use `NULL`, not `NA`. --- - Invalid `labels` specification. Use "NULL", not "NA". + Invalid `labels` specification. Use `NULL`, not `NA`. --- - `breaks` and `labels` are different lengths. + `breaks` and `labels` have different lengths. # numeric scale transforms can produce breaks @@ -51,12 +51,12 @@ # training incorrectly appropriately communicates the offenders - Continuous values supplied to discrete scale + Continuous values supplied to discrete scale. i Example values: 1, 2, 3, 4, and 5 --- - Discrete values supplied to continuous scale + Discrete values supplied to continuous scale. i Example values: "A", "B", "C", "D", and "E" # Using `scale_name` prompts deprecation message diff --git a/tests/testthat/_snaps/sec-axis.md b/tests/testthat/_snaps/sec-axis.md index f6b607372b..1e1c8f1c9f 100644 --- a/tests/testthat/_snaps/sec-axis.md +++ b/tests/testthat/_snaps/sec-axis.md @@ -1,12 +1,12 @@ # sec_axis checks the user input - Secondary axes must be specified using `sec_axis()` + Secondary axes must be specified using `sec_axis()`. --- - Transformation for secondary axes must be a function + Transformation for secondary axes must be a function. --- - Transformation for secondary axes must be monotonic + Transformation for secondary axes must be monotonic. diff --git a/tests/testthat/_snaps/stat-bin.md b/tests/testthat/_snaps/stat-bin.md index c68603756b..dd7a8127bf 100644 --- a/tests/testthat/_snaps/stat-bin.md +++ b/tests/testthat/_snaps/stat-bin.md @@ -17,39 +17,39 @@ Problem while computing stat. i Error occurred in the 1st layer. Caused by error in `setup_params()`: - ! `stat_bin()` requires a continuous x aesthetic + ! `stat_bin()` requires a continuous x aesthetic. x the x aesthetic is discrete. i Perhaps you want `stat="count"`? # inputs to binning are checked - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bins()`: ! `breaks` must be a vector, not a character vector. --- - `x_range` must have two elements + `x_range` must have two elements. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_width()`: - ! `width` must be a number, not a character vector. + ! `binwidth` must be a number, not a character vector. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_width()`: - ! `binwidth` must be positive + ! `binwidth` must be a number larger than or equal to 0, not the number -4. --- - `x_range` must have two elements + `x_range` must have two elements. --- - Computation failed in `stat_bin()` + Computation failed in `stat_bin()`. Caused by error in `bin_breaks_bins()`: ! `bins` must be a whole number larger than or equal to 1, not the number -4. diff --git a/tests/testthat/_snaps/stat-bin2d.md b/tests/testthat/_snaps/stat-bin2d.md index 260722e175..ffc60d7f92 100644 --- a/tests/testthat/_snaps/stat-bin2d.md +++ b/tests/testthat/_snaps/stat-bin2d.md @@ -1,12 +1,12 @@ # binwidth is respected - Computation failed in `stat_bin2d()` + Computation failed in `stat_bin2d()`. Caused by error in `bin2d_breaks()`: ! `binwidth` must be a number, not a double vector. --- - Computation failed in `stat_bin2d()` + Computation failed in `stat_bin2d()`. Caused by error in `bin2d_breaks()`: ! `origin` must be a number, not a double vector. diff --git a/tests/testthat/_snaps/stat-density2d.md b/tests/testthat/_snaps/stat-density2d.md index c1bf610cc0..a8840aaa76 100644 --- a/tests/testthat/_snaps/stat-density2d.md +++ b/tests/testthat/_snaps/stat-density2d.md @@ -3,6 +3,5 @@ Problem while computing stat. i Error occurred in the 1st layer. Caused by error in `compute_layer()`: - ! Invalid value of `contour_var` ("abcd") - i Supported values are "density", "ndensity", and "count". + ! `contour_var` must be one of "density", "ndensity", or "count", not "abcd". diff --git a/tests/testthat/_snaps/stat-qq.md b/tests/testthat/_snaps/stat-qq.md index 24f4890db7..3be2b1b4e4 100644 --- a/tests/testthat/_snaps/stat-qq.md +++ b/tests/testthat/_snaps/stat-qq.md @@ -1,18 +1,18 @@ # error is thrown with wrong quantile input - Computation failed in `stat_qq()` + Computation failed in `stat_qq()`. Caused by error in `compute_group()`: - ! The length of `quantiles` must match the length of the data + ! The length of `quantiles` must match the length of the data. --- - Computation failed in `stat_qq_line()` + Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: - ! `quantiles` must have the same length as the data + ! `quantiles` must have the same length as the data. --- - Computation failed in `stat_qq_line()` + Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: ! Cannot fit line quantiles 0.15. `line.p` must have length 2. diff --git a/tests/testthat/_snaps/stat-ydensity.md b/tests/testthat/_snaps/stat-ydensity.md index 06c9915c9c..1511b0b462 100644 --- a/tests/testthat/_snaps/stat-ydensity.md +++ b/tests/testthat/_snaps/stat-ydensity.md @@ -1,8 +1,8 @@ # calc_bw() requires at least two values and correct method - `x` must contain at least 2 elements to select a bandwidth automatically + `x` must contain at least 2 elements to select a bandwidth automatically. --- - `test` is not a valid bandwidth rule + `test` is not a valid bandwidth rule. diff --git a/tests/testthat/_snaps/stats.md b/tests/testthat/_snaps/stats.md new file mode 100644 index 0000000000..92a4296185 --- /dev/null +++ b/tests/testthat/_snaps/stats.md @@ -0,0 +1,6 @@ +# erroneously dropped aesthetics are found and issue a warning + + The following aesthetics were dropped during statistical transformation: colour and fill. + i This can happen when ggplot fails to infer the correct grouping structure in the data. + i Did you forget to specify a `group` aesthetic or to convert a numerical variable into a factor? + diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index af1b3d4744..259a887c1a 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -4,21 +4,21 @@ --- - Theme element `text` must have class + Theme element `text` must have class . # incorrect theme specifications throw meaningful errors - Problem merging the `line` theme element + Can't merge the `line` theme element. Caused by error in `merge_element()`: - ! Only elements of the same class can be merged + ! Only elements of the same class can be merged. --- - Theme element `line` must have class + Theme element `line` must have class . --- - Theme element `test` has "NULL" property without default: fill, colour, linewidth, and linetype + Theme element `test` has `NULL` property without default: fill, colour, linewidth, and linetype. --- diff --git a/tests/testthat/_snaps/utilities.md b/tests/testthat/_snaps/utilities.md index 06692d753b..804ce1ad27 100644 --- a/tests/testthat/_snaps/utilities.md +++ b/tests/testthat/_snaps/utilities.md @@ -1,18 +1,18 @@ # check_required_aesthetics() errors on missing - `test()` requires the following missing aesthetics: y + `test()` requires the following missing aesthetics: y. --- - `test()` requires the following missing aesthetics: x and y + `test()` requires the following missing aesthetics: x and y. --- - `test()` requires the following missing aesthetics: x or y + `test()` requires the following missing aesthetics: x or y. --- - `test()` requires the following missing aesthetics: x and fill or y and fill + `test()` requires the following missing aesthetics: x and fill or y and fill. # remove_missing checks input @@ -44,7 +44,7 @@ --- - Specify exactly one of `n` and `width` + Specify exactly one of `n` and `width`. --- diff --git a/tests/testthat/test-ggsave.R b/tests/testthat/test-ggsave.R index 4e53dc39d3..a5d7a5283c 100644 --- a/tests/testthat/test-ggsave.R +++ b/tests/testthat/test-ggsave.R @@ -93,7 +93,7 @@ test_that("ggsave fails informatively for no-extension filenames", { plot <- ggplot(mtcars, aes(disp, mpg)) + geom_point() expect_error( ggsave(tempfile(), plot), - '`filename` has no file extension and `device` is "NULL"' + "Can't save to" ) }) diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R index 6c46bb38df..b1acda601e 100644 --- a/tests/testthat/test-stats.R +++ b/tests/testthat/test-stats.R @@ -13,7 +13,7 @@ test_that("plot succeeds even if some computation fails", { test_that("error message is thrown when aesthetics are missing", { p <- ggplot(mtcars) + stat_sum() - expect_error(ggplot_build(p), "x and y$") + expect_error(ggplot_build(p), "x and y\\.$") }) test_that("erroneously dropped aesthetics are found and issue a warning", { @@ -40,9 +40,8 @@ test_that("erroneously dropped aesthetics are found and issue a warning", { ) p2 <- ggplot(df2, aes(id, colour = colour, fill = fill)) + geom_bar() - expect_warning( - b2 <- ggplot_build(p2), - "The following aesthetics were dropped during statistical transformation: .*colour.*, .*fill.*" + expect_snapshot_warning( + b2 <- ggplot_build(p2) ) # colour is dropped because group a's colour is not constant (GeomBar$default_aes$colour is NA) From 6df5cd404bde8fbbf2b10200eed9670d283ac97f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 4 Dec 2023 16:27:51 +0100 Subject: [PATCH 05/22] `theme()` supports splicing arguments (#5543) * Move `...` to first argument * `find_args()` uses `list2()` * add test * add news bullet --- NEWS.md | 2 ++ R/theme.R | 4 ++-- R/utilities.R | 2 +- man/theme.Rd | 8 ++++---- tests/testthat/test-theme.R | 7 +++++++ 5 files changed, 16 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index 359d54ffb9..e7a7d06612 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* `theme()` now supports splicing a list of arguments (#5542). + * Contour functions will not fail when `options("OutDec")` is not `.` (@eliocamp, #5555). * The `legend.key` theme element is set to inherit from the `panel.background` diff --git a/R/theme.R b/R/theme.R index 70a5f8c7a6..dda2dcd8c8 100644 --- a/R/theme.R +++ b/R/theme.R @@ -281,7 +281,8 @@ #' p3 + theme(strip.text.x.top = element_text(colour = "white", face = "bold")) #' p3 + theme(panel.spacing = unit(1, "lines")) #' } -theme <- function(line, +theme <- function(..., + line, rect, text, title, @@ -388,7 +389,6 @@ theme <- function(line, strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, - ..., complete = FALSE, validate = TRUE) { elements <- find_args(..., complete = NULL, validate = NULL) diff --git a/R/utilities.R b/R/utilities.R index b16540d9c5..83ee801273 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -320,7 +320,7 @@ find_args <- function(...) { vals <- mget(args, envir = env) vals <- vals[!vapply(vals, is_missing_arg, logical(1))] - modify_list(vals, list(..., `...` = NULL)) + modify_list(vals, list2(..., `...` = NULL)) } # Used in annotations to ensure printed even when no diff --git a/man/theme.Rd b/man/theme.Rd index 7672d42c5a..4c91c5fe85 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -5,6 +5,7 @@ \title{Modify components of a theme} \usage{ theme( + ..., line, rect, text, @@ -112,12 +113,14 @@ theme( strip.text.y.right, strip.switch.pad.grid, strip.switch.pad.wrap, - ..., complete = FALSE, validate = TRUE ) } \arguments{ +\item{...}{additional element specifications not part of base ggplot2. In general, +these should also be defined in the \verb{element tree} argument.} + \item{line}{all line elements (\code{\link[=element_line]{element_line()}})} \item{rect}{all rectangular elements (\code{\link[=element_rect]{element_rect()}})} @@ -298,9 +301,6 @@ switched (\code{unit})} \item{strip.switch.pad.wrap}{space between strips and axes when strips are switched (\code{unit})} -\item{...}{additional element specifications not part of base ggplot2. In general, -these should also be defined in the \verb{element tree} argument.} - \item{complete}{set this to \code{TRUE} if this is a complete theme, such as the one returned by \code{\link[=theme_grey]{theme_grey()}}. Complete themes behave differently when added to a ggplot object. Also, when setting diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index ab54bf9764..53feb08832 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -6,6 +6,13 @@ test_that("dollar subsetting the theme does no partial matching", { expect_equal(t$foobar, 12) }) +test_that("theme argument splicing works", { + l <- list(a = 10, b = "c", d = c("foo", "bar")) + test <- theme(!!!l) + ref <- theme(a = 10, b = "c", d = c("foo", "bar")) + expect_equal(test, ref) +}) + test_that("modifying theme element properties with + operator works", { # Changing a "leaf node" works From 3765b97ec0f7e491a639dfdda68b49bfef00fe11 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 4 Dec 2023 17:20:29 +0100 Subject: [PATCH 06/22] Custom guide (#5496) * guides are named by their hash * Pumbing for custom guides * draft version * Document stuff * Add topic to pkgdown * prepend grid namespace to example * Adapt to new `Guide$draw()` formals * keep custom guides when there are no scales * sort grobs after drawing * Add news bullet --- DESCRIPTION | 1 + NAMESPACE | 2 + NEWS.md | 3 + R/guide-custom.R | 159 +++++++++++++++++++++++++++++++++++++++++ R/guides-.R | 33 +++++++-- R/plot-build.R | 4 +- _pkgdown.yml | 1 + man/ggplot2-ggproto.Rd | 51 ++++++------- man/guide_custom.Rd | 67 +++++++++++++++++ 9 files changed, 287 insertions(+), 34 deletions(-) create mode 100644 R/guide-custom.R create mode 100644 man/guide_custom.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3815343626..3fc6116632 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -181,6 +181,7 @@ Collate: 'guide-bins.R' 'guide-colorbar.R' 'guide-colorsteps.R' + 'guide-custom.R' 'layer.R' 'guide-none.R' 'guide-old.R' diff --git a/NAMESPACE b/NAMESPACE index cb893f08e8..b423ca0bbc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -217,6 +217,7 @@ export(GuideAxisLogticks) export(GuideBins) export(GuideColourbar) export(GuideColoursteps) +export(GuideCustom) export(GuideLegend) export(GuideNone) export(GuideOld) @@ -429,6 +430,7 @@ export(guide_colorbar) export(guide_colorsteps) export(guide_colourbar) export(guide_coloursteps) +export(guide_custom) export(guide_gengrob) export(guide_geom) export(guide_legend) diff --git a/NEWS.md b/NEWS.md index e7a7d06612..96ca2cdf69 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* New `guide_custom()` function for drawing custom graphical objects (grobs) + unrelated to scales in legend positions (#5416). + * `theme()` now supports splicing a list of arguments (#5542). * Contour functions will not fail when `options("OutDec")` is not `.` (@eliocamp, #5555). diff --git a/R/guide-custom.R b/R/guide-custom.R new file mode 100644 index 0000000000..3ea4fc3ffe --- /dev/null +++ b/R/guide-custom.R @@ -0,0 +1,159 @@ +#' Custom guides +#' +#' This is a special guide that can be used to display any graphical object +#' (grob) along with the regular guides. This guide has no associated scale. +#' +#' @param grob A grob to display. +#' @param width,height The allocated width and height to display the grob, given +#' in [grid::unit()]s. +#' @param title A character string or expression indicating the title of guide. +#' If `NULL` (default), no title is shown. +#' @param title.position A character string indicating the position of a title. +#' One of `"top"` (default), `"bottom"`, `"left"` or `"right"`. +#' @param margin Margins around the guide. See [margin()] for more details. If +#' `NULL` (default), margins are taken from the `legend.margin` theme setting. +#' @param position Currently not in use. +#' @inheritParams guide_legend +#' +#' @export +#' +#' @examples +#' # A standard plot +#' p <- ggplot(mpg, aes(displ, hwy)) + +#' geom_point() +#' +#' # Define a graphical object +#' circle <- grid::circleGrob() +#' +#' # Rendering a grob as a guide +#' p + guides(custom = guide_custom(circle, title = "My circle")) +#' +#' # Controlling the size of the grob defined in relative units +#' p + guides(custom = guide_custom( +#' circle, title = "My circle", +#' width = unit(2, "cm"), height = unit(2, "cm")) +#' ) +#' +#' # Size of grobs in absolute units is taken directly without the need to +#' # set these manually +#' p + guides(custom = guide_custom( +#' title = "My circle", +#' grob = grid::circleGrob(r = unit(1, "cm")) +#' )) +guide_custom <- function( + grob, width = grobWidth(grob), height = grobHeight(grob), + title = NULL, title.position = "top", margin = NULL, + position = waiver(), order = 0 +) { + check_object(grob, is.grob, "a {.cls grob} object") + check_object(width, is.unit, "a {.cls unit} object") + check_object(height, is.unit, "a {.cls unit} object") + check_object(margin, is.margin, "a {.cls margin} object", allow_null = TRUE) + if (length(width) != 1) { + cli::cli_abort("{.arg width} must be a single {.cls unit}, not a unit vector.") + } + if (length(height) != 1) { + cli::cli_abort("{.arg height} must be a single {.cls unit}, not a unit vector.") + } + title.position <- arg_match0(title.position, .trbl) + + new_guide( + grob = grob, + width = width, + height = height, + title = title, + title.position = title.position, + margin = margin, + hash = hash(list(title, grob)), # hash is already known + position = position, + order = order, + available_aes = "any", + super = GuideCustom + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GuideCustom <- ggproto( + "GuideCustom", Guide, + + params = c(Guide$params, list( + grob = NULL, width = NULL, height = NULL, + margin = NULL, + title = NULL, + title.position = "top" + )), + + hashables = exprs(title, grob), + + elements = list( + background = "legend.background", + theme.margin = "legend.margin", + theme.title = "legend.title" + ), + + train = function(...) { + params + }, + + transform = function(...) { + params + }, + + override_elements = function(params, elements, theme) { + elements$title <- elements$theme.title + elements$margin <- params$margin %||% elements$theme.margin + elements + }, + + draw = function(self, theme, position = NULL, direction = NULL, + params = self$params) { + + # Render title + elems <- self$setup_elements(params, self$elements, theme) + elems <- self$override_elements(params, elems, theme) + if (!is.waive(params$title) && !is.null(params$title)) { + title <- self$build_title(params$title, elems, params) + } else { + title <- zeroGrob() + } + title.position <- params$title.position + if (is.zero(title)) { + title.position <- "none" + } + + width <- convertWidth(params$width, "cm") + height <- convertHeight(params$height, "cm") + gt <- gtable(widths = width, heights = height) + gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1, clip = "off") + + if (params$title.position == "top") { + gt <- gtable_add_rows(gt, elems$margin[1], pos = 0) + gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "bottom") { + gt <- gtable_add_rows(gt, elems$margin[3], pos = -1) + gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = -1) + gt <- gtable_add_grob(gt, title, t = -1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "left") { + gt <- gtable_add_cols(gt, elems$margin[4], pos = 0) + gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off") + } else if (params$title.position == "right") { + gt <- gtable_add_cols(gt, elems$margin[2], pos = -1) + gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0) + gt <- gtable_add_grob(gt, title, t = 1, l = -1, name = "title", clip = "off") + } + gt <- gtable_add_padding(gt, elems$margin) + + background <- element_grob(elems$background) + gt <- gtable_add_grob( + gt, background, + t = 1, l = 1, r = -1, b = -1, + z = -Inf, clip = "off" + ) + gt + } +) diff --git a/R/guides-.R b/R/guides-.R index 19348ec157..ee1ddb2477 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -248,6 +248,18 @@ Guides <- ggproto( ) }, + get_custom = function(self) { + custom <- vapply(self$guides, inherits, logical(1), what = "GuideCustom") + n_custom <- sum(custom) + if (n_custom < 1) { + return(guides_list()) + } + custom <- guides_list(self$guides[custom]) + custom$params <- lapply(custom$guides, `[[`, "params") + custom$merge() + custom + }, + ## Building ------------------------------------------------------------------ # The `Guides$build()` method is called in ggplotGrob (plot-build.R) and makes @@ -281,7 +293,8 @@ Guides <- ggproto( build = function(self, scales, layers, labels, layer_data) { # Empty guides list - no_guides <- guides_list() + custom <- self$get_custom() + no_guides <- custom # Extract the non-position scales scales <- scales$non_position_scales()$scales @@ -308,6 +321,10 @@ Guides <- ggproto( if (length(guides$guides) == 0) { return(no_guides) } + + guides$guides <- c(guides$guides, custom$guides) + guides$params <- c(guides$params, custom$params) + guides }, @@ -413,11 +430,6 @@ Guides <- ggproto( # Bundle together guides and their parameters pairs <- Map(list, guide = self$guides, params = self$params) - # If there is only one guide, we can exit early, because nothing to merge - if (length(pairs) == 1) { - return() - } - # The `{order}_{hash}` combination determines groups of guides orders <- vapply(self$params, `[[`, 0, "order") orders[orders == 0] <- 99 @@ -425,10 +437,16 @@ Guides <- ggproto( hashes <- vapply(self$params, `[[`, "", "hash") hashes <- paste(orders, hashes, sep = "_") + # If there is only one guide, we can exit early, because nothing to merge + if (length(pairs) == 1) { + names(self$guides) <- hashes + return() + } + # Split by hashes indices <- split(seq_along(pairs), hashes) indices <- vapply(indices, `[[`, 0L, 1L, USE.NAMES = FALSE) # First index - groups <- unname(split(pairs, hashes)) + groups <- split(pairs, hashes) lens <- lengths(groups) # Merge groups with >1 member @@ -495,6 +513,7 @@ Guides <- ggproto( if (length(grobs) < 1) { return(zeroGrob()) } + grobs <- grobs[order(names(grobs))] # Set spacing theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines") diff --git a/R/plot-build.R b/R/plot-build.R index cc2790d7ed..7fa0a89be3 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -94,8 +94,8 @@ ggplot_build.ggplot <- function(plot) { plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data) data <- lapply(data, npscales$map_df) } else { - # Assign empty guides if there are no non-position scales - plot$guides <- guides_list() + # Only keep custom guides if there are no non-position scales + plot$guides <- plot$guides$get_custom() } # Fill in defaults etc. diff --git a/_pkgdown.yml b/_pkgdown.yml index 1bbe6e33ef..43fc512789 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -130,6 +130,7 @@ reference: - guide_axis_theta - guide_bins - guide_coloursteps + - guide_custom - guide_none - guides - sec_axis diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 728fcb2410..ebc8961b45 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -1,31 +1,31 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaa-.R, R/geom-.R, R/annotation-custom.R, % R/annotation-logticks.R, R/geom-polygon.R, R/geom-map.R, R/annotation-map.R, -% R/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, R/coord-.R, -% R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R, -% R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, R/coord-transform.R, -% R/facet-.R, R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, -% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, -% R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, R/geom-contour.R, -% R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, R/geom-ribbon.R, -% R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, R/geom-errorbar.R, -% R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, -% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, -% 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-legend.R, R/guide-bins.R, -% R/guide-colorbar.R, R/guide-colorsteps.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/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, +% R/coord-.R, R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, +% R/coord-map.R, R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, +% R/coord-transform.R, R/facet-.R, R/facet-grid-.R, R/facet-null.R, +% R/facet-wrap.R, R/stat-.R, R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, +% R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, +% R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, +% R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, +% R/geom-errorbar.R, R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, +% R/geom-hline.R, R/geom-label.R, R/geom-linerange.R, R/geom-point.R, +% R/geom-pointrange.R, 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-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} @@ -96,6 +96,7 @@ \alias{GuideBins} \alias{GuideColourbar} \alias{GuideColoursteps} +\alias{GuideCustom} \alias{GuideNone} \alias{GuideOld} \alias{Layout} diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd new file mode 100644 index 0000000000..3893dbc2c9 --- /dev/null +++ b/man/guide_custom.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-custom.R +\name{guide_custom} +\alias{guide_custom} +\title{Custom guides} +\usage{ +guide_custom( + grob, + width = grobWidth(grob), + height = grobHeight(grob), + title = NULL, + title.position = "top", + margin = NULL, + position = waiver(), + order = 0 +) +} +\arguments{ +\item{grob}{A grob to display.} + +\item{width, height}{The allocated width and height to display the grob, given +in \code{\link[grid:unit]{grid::unit()}}s.} + +\item{title}{A character string or expression indicating the title of guide. +If \code{NULL} (default), no title is shown.} + +\item{title.position}{A character string indicating the position of a title. +One of \code{"top"} (default), \code{"bottom"}, \code{"left"} or \code{"right"}.} + +\item{margin}{Margins around the guide. See \code{\link[=margin]{margin()}} for more details. If +\code{NULL} (default), margins are taken from the \code{legend.margin} theme setting.} + +\item{position}{Currently not in use.} + +\item{order}{positive integer less than 99 that specifies the order of +this guide among multiple guides. This controls the order in which +multiple guides are displayed, not the contents of the guide itself. +If 0 (default), the order is determined by a secret algorithm.} +} +\description{ +This is a special guide that can be used to display any graphical object +(grob) along with the regular guides. This guide has no associated scale. +} +\examples{ +# A standard plot +p <- ggplot(mpg, aes(displ, hwy)) + + geom_point() + +# Define a graphical object +circle <- grid::circleGrob() + +# Rendering a grob as a guide +p + guides(custom = guide_custom(circle, title = "My circle")) + +# Controlling the size of the grob defined in relative units +p + guides(custom = guide_custom( + circle, title = "My circle", + width = unit(2, "cm"), height = unit(2, "cm")) +) + +# Size of grobs in absolute units is taken directly without the need to +# set these manually +p + guides(custom = guide_custom( + title = "My circle", + grob = grid::circleGrob(r = unit(1, "cm")) +)) +} From b38caa3e5e065ab964ce75a7954ebaff6c6c4894 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 6 Dec 2023 10:14:06 +0100 Subject: [PATCH 07/22] Stacked axes (#5473) * first draft * Sprinkle some comments * roxygenate * Add test * Add pkgdown item * pass along position/direction * measure size of theta axes * stacked axis is valid theta axis * stack theta axes * incorporate offset into theta guide * fix angle/justification for radial axes * enable theta.sec * add radial test * Add news bullet --- DESCRIPTION | 1 + NAMESPACE | 2 + NEWS.md | 2 + R/guide-axis-stack.R | 242 ++++++++++++++++++ R/guide-axis-theta.R | 104 +++++++- _pkgdown.yml | 1 + man/ggplot2-ggproto.Rd | 27 +- man/guide_axis_stack.Rd | 58 +++++ tests/testthat/_snaps/guides/stacked-axes.svg | 148 +++++++++++ .../_snaps/guides/stacked-radial-axes.svg | 143 +++++++++++ tests/testthat/test-guides.R | 26 +- 11 files changed, 732 insertions(+), 22 deletions(-) create mode 100644 R/guide-axis-stack.R create mode 100644 man/guide_axis_stack.Rd create mode 100644 tests/testthat/_snaps/guides/stacked-axes.svg create mode 100644 tests/testthat/_snaps/guides/stacked-radial-axes.svg diff --git a/DESCRIPTION b/DESCRIPTION index 3fc6116632..c5c8af640e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -176,6 +176,7 @@ Collate: 'guide-.R' 'guide-axis.R' 'guide-axis-logticks.R' + 'guide-axis-stack.R' 'guide-axis-theta.R' 'guide-legend.R' 'guide-bins.R' diff --git a/NAMESPACE b/NAMESPACE index b423ca0bbc..1e43aa78ad 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -214,6 +214,7 @@ export(GeomVline) export(Guide) export(GuideAxis) export(GuideAxisLogticks) +export(GuideAxisStack) export(GuideBins) export(GuideColourbar) export(GuideColoursteps) @@ -424,6 +425,7 @@ export(ggsave) export(ggtitle) export(guide_axis) export(guide_axis_logticks) +export(guide_axis_stack) export(guide_axis_theta) export(guide_bins) export(guide_colorbar) diff --git a/NEWS.md b/NEWS.md index 96ca2cdf69..992d5cc395 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `guide_axis_stack()` to combine other axis guides on top of one another. + * New `guide_custom()` function for drawing custom graphical objects (grobs) unrelated to scales in legend positions (#5416). diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R new file mode 100644 index 0000000000..2fdd73b34e --- /dev/null +++ b/R/guide-axis-stack.R @@ -0,0 +1,242 @@ +#' @include guide-axis.R +NULL + +#' Stacked axis guides +#' +#' This guide can stack other position guides that represent position scales, +#' like those created with [scale_(x|y)_continuous()][scale_x_continuous()] and +#' [scale_(x|y)_discrete()][scale_x_discrete()]. +#' +#' @inheritParams guide_axis +#' @param first A position guide given as one of the following: +#' * A string, for example `"axis"`. +#' * A call to a guide function, for example `guide_axis()`. +#' @param ... Additional guides to stack given in the same manner as `first`. +#' @param spacing A [unit()] objects that determines how far separate guides are +#' spaced apart. +#' +#' @details +#' The `first` guide will be placed closest to the panel and any subsequent +#' guides provided through `...` will follow in the given order. +#' +#' @export +#' +#' @examples +#' #' # A standard plot +#' p <- ggplot(mpg, aes(displ, hwy)) + +#' geom_point() + +#' theme(axis.line = element_line()) +#' +#' # A normal axis first, then a capped axis +#' p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both"))) +guide_axis_stack <- function(first = "axis", ..., title = waiver(), + spacing = NULL, order = 0, position = waiver()) { + + check_object(spacing, is.unit, "{.cls unit}", allow_null = TRUE) + + # Validate guides + axes <- list2(first, ...) + axes <- lapply(axes, validate_guide) + + # Check available aesthetics + available <- lapply(axes, `[[`, name = "available_aes") + available <- vapply(available, function(x) all(c("x", "y") %in% x), logical(1)) + if (all(!available)) { + cli::cli_abort(paste0( + "{.fn guide_axis_stack} can only use guides that handle {.field x} and ", + "{.field y} aesthetics." + )) + } + + # Remove guides that don't support x/y aesthetics + if (any(!available)) { + remove <- which(!available) + removed <- vapply(axes[remove], snake_class, character(1)) + axes[remove] <- NULL + cli::cli_warn(c(paste0( + "{.fn guide_axis_stack} cannot use the following guide{?s}: ", + "{.and {.fn {removed}}}." + ), i = "Guides need to handle {.field x} and {.field y} aesthetics.")) + } + + params <- lapply(axes, `[[`, name = "params") + + new_guide( + title = title, + guides = axes, + guide_params = params, + available_aes = c("x", "y", "theta", "r"), + order = order, + position = position, + name = "stacked_axis", + super = GuideAxisStack + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GuideAxisStack <- ggproto( + "GuideAxisStack", GuideAxis, + + params = list( + # List of guides to track the guide objects + guides = list(), + # List of parameters to each guide + guide_params = list(), + # Standard guide stuff + name = "stacked_axis", + title = waiver(), + angle = waiver(), + hash = character(), + position = waiver(), + direction = NULL, + order = 0 + ), + + available_aes = c("x", "y", "theta", "r"), + + # Doesn't depend on keys, but on member axis' class + hashables = exprs(title, lapply(guides, snake_class), name), + + # Sets position, loops through guides to train + train = function(self, params = self$params, scale, aesthetic = NULL, ...) { + position <- arg_match0( + params$position, c(.trbl, "theta", "theta.sec"), + arg_nm = "position" + ) + for (i in seq_along(params$guides)) { + params$guide_params[[i]]$position <- position + params$guide_params[[i]]$angle <- params$guide_params[[i]]$angle %|W|% params$angle + params$guide_params[[i]] <- params$guides[[i]]$train( + params = params$guide_params[[i]], + scale = scale, aesthetic = aesthetic, + ... + ) + } + params + }, + + # Just loops through guides + transform = function(self, params, coord, panel_params) { + for (i in seq_along(params$guides)) { + params$guide_params[[i]] <- params$guides[[i]]$transform( + params = params$guide_params[[i]], + coord = coord, panel_params = panel_params + ) + } + params + }, + + # Just loops through guides + get_layer_key = function(params, layers) { + for (i in seq_along(params$guides)) { + params$guide_params[[i]] <- params$guides[[i]]$get_layer_key( + params = params$guide_params[[i]], + layers = layers + ) + } + params + }, + + draw = function(self, theme, position = NULL, direction = NULL, + params = self$params) { + + position <- params$position %||% position + direction <- params$direction %||% direction + + 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 + # next guide. + offset <- unit(0, "cm") + spacing <- params$spacing %||% unit(2.25, "pt") + grobs <- list() + for (i in seq_along(params$guides)) { + # Add offset to params + pars <- params$guide_params[[i]] + pars$stack_offset <- offset + # Draw guide + grobs[[i]] <- params$guides[[i]]$draw( + theme, position = position, direction = direction, + params = pars + ) + # Increment offset + if (!is.null(grobs[[i]]$offset)) { + offset <- offset + spacing + grobs[[i]]$offset + offset <- convertUnit(offset, "cm") + } + } + grob <- inject(grobTree(!!!grobs)) + return(grob) + } + + # Loop through every guide's draw method + grobs <- list() + for (i in seq_along(params$guides)) { + grobs[[i]] <- params$guides[[i]]$draw( + theme, position = position, direction = direction, + params = params$guide_params[[i]] + ) + } + + # Remove empty grobs + grobs <- grobs[!vapply(grobs, is.zero, logical(1))] + if (length(grobs) == 0) { + return(zeroGrob()) + } + along <- seq_along(grobs) + + # Get sizes + widths <- inject(unit.c(!!!lapply(grobs, grobWidth))) + heights <- inject(unit.c(!!!lapply(grobs, grobHeight))) + + # Set spacing + if (is.null(params$spacing)) { + aes <- if (position %in% c("top", "bottom")) "x" else "y" + spacing <- paste("axis.ticks.length", aes, position, sep = ".") + spacing <- calc_element(spacing, theme) + } else { + spacing <- params$spacing + } + + # Reorder grobs/sizes if necessary + if (position %in% c("top", "left")) { + along <- rev(along) + widths <- rev(widths) + heights <- rev(heights) + } + + # Place guides in a gtable, apply spacing + if (position %in% c("bottom", "top")) { + gt <- gtable(widths = unit(1, "npc"), heights = heights) + gt <- gtable_add_grob(gt, grobs, t = along, l = 1, name = "axis", clip = "off") + gt <- gtable_add_row_space(gt, height = spacing) + vp <- exec( + viewport, + y = unit(as.numeric(position == "bottom"), "npc"), + height = grobHeight(gt), + just = opposite_position(position) + ) + } else { + gt <- gtable(widths = widths, heights = unit(1, "npc")) + gt <- gtable_add_grob(gt, grobs, t = 1, l = along, name = "axis", clip = "off") + gt <- gtable_add_col_space(gt, width = spacing) + vp <- exec( + viewport, + x = unit(as.numeric(position == "left"), "npc"), + width = grobWidth(gt), + just = opposite_position(position) + ) + } + + absoluteGrob( + grob = gList(gt), + width = gtable_width(gt), + height = gtable_height(gt), + vp = vp + ) + } +) + diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index abdc9277c1..c8c8fa3619 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -158,6 +158,24 @@ GuideAxisTheta <- ggproto( elements }, + build_decor = function(decor, grobs, elements, params) { + if (is.null(params$stack_offset) || !("theta" %in% names(decor))) { + # Just use regular method if we do not need to offset the guide + decor <- GuideAxis$build_decor(decor, grobs, elements, params) + return(decor) + } + if (empty(decor)) { + return(zeroGrob()) + } + if (params$position == "theta.sec") { + decor$theta <- decor$theta + pi + } + # Add the stacking offset to positions + x <- unit(decor$x, "npc") + sin(decor$theta) * params$stack_offset + y <- unit(decor$y, "npc") + cos(decor$theta) * params$stack_offset + element_grob(elements$line, x = x, y = y) + }, + build_labels = function(key, elements, params) { if (inherits(elements$text, "element_blank")) { @@ -183,9 +201,15 @@ GuideAxisTheta <- ggproto( # Position angle in radians theta <- key$theta + # Add the stacking offset if necessary + offset <- elements$offset + if (!is.null(params$stack_offset)) { + offset <- offset + params$stack_offset + } + # Offset distance to displace text away from outer circle line - xoffset <- elements$offset * sin(theta) - yoffset <- elements$offset * cos(theta) + xoffset <- offset * sin(theta) + yoffset <- offset * cos(theta) # Note that element_grob expects 1 angle for *all* labels, so we're # rendering one grob per label to propagate angle properly @@ -201,14 +225,14 @@ GuideAxisTheta <- ggproto( }, build_ticks = function(key, elements, params, position = params$position) { - + offset <- params$stack_offset major <- theta_tickmarks( vec_slice(key, (key$.type %||% "major") == "major"), - elements$ticks, elements$major_length + elements$ticks, elements$major_length, offset = offset ) minor <- theta_tickmarks( vec_slice(key, (key$.type %||% "major") == "minor"), - elements$minor, elements$minor_length + elements$minor, elements$minor_length, offset = offset ) grobTree(major, minor, name = "ticks") @@ -219,7 +243,63 @@ GuideAxisTheta <- ggproto( # we don't need to measure grob sizes nor arrange the layout. # There is a fallback in `$assemble_drawing()` that takes care of this # for non-polar coordinates. - NULL + if (is.null(params$stack_offset)) { + return(NULL) + } + + # However, when this guide is part of a stacked axis guide, we need to + # know the width of the 'ring' that this guide occupies to correctly + # position the next guide + + offset <- convertUnit(elements$offset, "cm", valueOnly = TRUE) + + key <- params$key + key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label)) + labels <- key$.label + if (length(labels) == 0 || inherits(elements$text, "element_blank")) { + return(list(offset = offset)) + } + + # Resolve text angle + if (is.waive(params$angle %||% waiver())) { + angle <- elements$text$angle + } else { + angle <- flip_text_angle(params$angle - rad2deg(key$theta)) + } + angle <- key$theta + deg2rad(angle) + + # Set margin + margin <- rep(max(elements$text$margin), length.out = 4) + + # Measure size of each individual label + single_labels <- lapply(labels, function(lab) { + element_grob( + elements$text, label = lab, + margin = margin, margin_x = TRUE, margin_y = TRUE + ) + }) + widths <- width_cm(single_labels) + heights <- height_cm(single_labels) + + # Set text justification + hjust <- 0.5 - sin(angle) / 2 + vjust <- 0.5 - cos(angle) / 2 + + # Calculate text bounding box + xmin <- widths * -hjust + xmax <- widths * (1 - hjust) + + ymin <- heights * -vjust + ymax <- heights * (1 - vjust) + + # Convert to corner coordinates + x <- vec_interleave(xmin, xmin, xmax, xmax) + y <- vec_interleave(ymin, ymax, ymax, ymin) + + # Rotate y coordinate to get maximum height + rotate <- rep(angle, each = 4) + height <- x * sin(rotate) + y * cos(rotate) + list(offset = max(height)) }, arrange_layout = function(key, sizes, params) { @@ -227,8 +307,13 @@ GuideAxisTheta <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { + if (params$position %in% c("theta", "theta.sec")) { - return(inject(grobTree(!!!grobs))) + # We append an 'offset' slot in case this guide is part + # of a stacked guide + grobs <- inject(gList(!!!grobs)) + offset <- unit(sizes$offset %||% 0, "cm") + return(gTree(offset = offset, children = grobs)) } # As a fallback, we adjust the viewport to act like regular axes. @@ -263,7 +348,7 @@ GuideAxisTheta <- ggproto( } ) -theta_tickmarks <- function(key, element, length) { +theta_tickmarks <- function(key, element, length, offset = NULL) { n_breaks <- nrow(key) if (n_breaks < 1 || inherits(element, "element_blank")) { return(zeroGrob()) @@ -274,6 +359,9 @@ theta_tickmarks <- function(key, element, length) { x <- rep(key$x, each = 2) y <- rep(key$y, each = 2) length <- rep(c(0, 1), times = n_breaks) * length + if (!is.null(offset)) { + length <- length + offset + } minor <- element_grob( element, diff --git a/_pkgdown.yml b/_pkgdown.yml index 43fc512789..1bf6161b79 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -127,6 +127,7 @@ reference: - guide_legend - guide_axis - guide_axis_logticks + - guide_axis_stack - guide_axis_theta - guide_bins - guide_coloursteps diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index ebc8961b45..789a28db3c 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -1,19 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaa-.R, R/geom-.R, R/annotation-custom.R, % R/annotation-logticks.R, R/geom-polygon.R, R/geom-map.R, R/annotation-map.R, -% R/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, -% R/coord-.R, R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, -% R/coord-map.R, R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, -% R/coord-transform.R, R/facet-.R, R/facet-grid-.R, R/facet-null.R, -% R/facet-wrap.R, R/stat-.R, R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, -% R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, -% R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, -% R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, -% R/geom-errorbar.R, R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, -% R/geom-hline.R, R/geom-label.R, R/geom-linerange.R, R/geom-point.R, -% R/geom-pointrange.R, 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/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, R/coord-.R, +% R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R, +% R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, R/coord-transform.R, +% R/facet-.R, R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, +% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, +% R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, R/geom-contour.R, +% R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, R/geom-ribbon.R, +% R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, R/geom-errorbar.R, +% R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, +% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, +% 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, @@ -92,6 +92,7 @@ \alias{Guide} \alias{GuideAxis} \alias{GuideAxisLogticks} +\alias{GuideAxisStack} \alias{GuideLegend} \alias{GuideBins} \alias{GuideColourbar} diff --git a/man/guide_axis_stack.Rd b/man/guide_axis_stack.Rd new file mode 100644 index 0000000000..63ae75b003 --- /dev/null +++ b/man/guide_axis_stack.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-axis-stack.R +\name{guide_axis_stack} +\alias{guide_axis_stack} +\title{Stacked axis guides} +\usage{ +guide_axis_stack( + first = "axis", + ..., + title = waiver(), + spacing = NULL, + order = 0, + position = waiver() +) +} +\arguments{ +\item{first}{A position guide given as one of the following: +\itemize{ +\item A string, for example \code{"axis"}. +\item A call to a guide function, for example \code{guide_axis()}. +}} + +\item{...}{Additional guides to stack given in the same manner as \code{first}.} + +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{spacing}{A \code{\link[=unit]{unit()}} objects that determines how far separate guides are +spaced apart.} + +\item{order}{A positive \code{integer} of length 1 that specifies the order of +this guide among multiple guides. This controls in which order guides are +merged if there are multiple guides for the same position. If 0 (default), +the order is determined by a secret algorithm.} + +\item{position}{Where this guide should be drawn: one of top, bottom, +left, or right.} +} +\description{ +This guide can stack other position guides that represent position scales, +like those created with \link[=scale_x_continuous]{scale_(x|y)_continuous()} and +\link[=scale_x_discrete]{scale_(x|y)_discrete()}. +} +\details{ +The \code{first} guide will be placed closest to the panel and any subsequent +guides provided through \code{...} will follow in the given order. +} +\examples{ +#' # A standard plot +p <- ggplot(mpg, aes(displ, hwy)) + + geom_point() + + theme(axis.line = element_line()) + +# A normal axis first, then a capped axis +p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both"))) +} diff --git a/tests/testthat/_snaps/guides/stacked-axes.svg b/tests/testthat/_snaps/guides/stacked-axes.svg new file mode 100644 index 0000000000..6d66656927 --- /dev/null +++ b/tests/testthat/_snaps/guides/stacked-axes.svg @@ -0,0 +1,148 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 + + + + +100 +200 +300 + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + +100 +200 +300 + + + + +100 +200 +300 +top +bottom +left +right +stacked axes + + diff --git a/tests/testthat/_snaps/guides/stacked-radial-axes.svg b/tests/testthat/_snaps/guides/stacked-radial-axes.svg new file mode 100644 index 0000000000..240e16d958 --- /dev/null +++ b/tests/testthat/_snaps/guides/stacked-radial-axes.svg @@ -0,0 +1,143 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + +100 +200 +300 + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 +hp +left +right +stacked radial axes + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 96c90efe96..58d5d04124 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -627,6 +627,31 @@ test_that("axis guides can be capped", { expect_doppelganger("axis guides with capped ends", p) }) +test_that("guide_axis_stack stacks axes", { + + left <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "left") + right <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "right") + bottom <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "bottom") + top <- guide_axis_stack("axis", guide_axis(cap = "both"), title = "top") + + p <- ggplot(mtcars, aes(hp, disp)) + + geom_point() + + theme(axis.line = element_line()) + + guides(x = bottom, x.sec = top, y = left, y.sec = right) + expect_doppelganger("stacked axes", p) + + bottom <- guide_axis_stack("axis_theta", guide_axis_theta(cap = "both")) + top <- guide_axis_stack("axis_theta", guide_axis_theta(cap = "both")) + + p <- ggplot(mtcars, aes(hp, disp)) + + geom_point() + + theme(axis.line = element_line()) + + coord_radial(start = 0.25 * pi, end = 1.75 * pi, donut = 0.5) + + guides(theta = top, theta.sec = bottom, r = left, r.sec = right) + expect_doppelganger("stacked radial axes", p) + +}) + test_that("logticks look as they should", { p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + @@ -660,7 +685,6 @@ test_that("logticks look as they should", { ) ) expect_doppelganger("logtick axes with customisation", p) - }) test_that("guides are positioned correctly", { From 41587fc1c1ebca39e7abb4af019c05b6d0736b4f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 6 Dec 2023 11:36:31 +0100 Subject: [PATCH 08/22] remove shape as non-missing aes (#5546) --- R/geom-segment.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/geom-segment.R b/R/geom-segment.R index 611ba85e2c..f32b61f876 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -103,7 +103,7 @@ geom_segment <- function(mapping = NULL, data = NULL, #' @export GeomSegment <- ggproto("GeomSegment", Geom, required_aes = c("x", "y", "xend|yend"), - non_missing_aes = c("linetype", "linewidth", "shape"), + non_missing_aes = c("linetype", "linewidth"), default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = NA), draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL, lineend = "butt", linejoin = "round", na.rm = FALSE) { @@ -111,7 +111,7 @@ GeomSegment <- ggproto("GeomSegment", Geom, data$yend <- data$yend %||% data$y data <- check_linewidth(data, snake_class(self)) data <- remove_missing(data, na.rm = na.rm, - c("x", "y", "xend", "yend", "linetype", "linewidth", "shape"), + c("x", "y", "xend", "yend", "linetype", "linewidth"), name = "geom_segment" ) From 5c7867d64e7b679c28e11dd73a8bd6da47e40ffa Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 6 Dec 2023 11:56:02 +0100 Subject: [PATCH 09/22] Silence tests (#5507) * set dotplot binwidth * set number of bins * fill in smooth defaults * silence coord replacements * stat_summary2d has been replace by stat_summary_2d * fill quantile formula * suppress scale type messages * suppress sp-related messages * use explicit tempfiles * Include snapshot renaming from #5504 --- ...=> scale-x-date-labels-label-date-m-d.svg} | 2 +- ...scale-x-date-labels-label-date-w-week.svg} | 2 +- tests/testthat/test-fortify.R | 11 ++++++++--- tests/testthat/test-function-args.R | 4 ++-- tests/testthat/test-geom-dotplot.R | 6 +++--- tests/testthat/test-geom-hline-vline-abline.R | 10 ++++------ tests/testthat/test-geom-quantile.R | 2 +- tests/testthat/test-geom-smooth.R | 10 ++++++---- tests/testthat/test-layer.R | 19 +++++++++++++------ tests/testthat/test-stat-bin.R | 6 +++--- tests/testthat/test-utilities-checks.R | 6 ++++-- 11 files changed, 46 insertions(+), 32 deletions(-) rename tests/testthat/_snaps/scale_date/{scale-x-date-labels-date-format-m-d.svg => scale-x-date-labels-label-date-m-d.svg} (97%) rename tests/testthat/_snaps/scale_date/{scale-x-date-labels-date-format-w-week.svg => scale-x-date-labels-label-date-w-week.svg} (97%) diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg index 49346a1c5e..1fef513fa1 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg @@ -51,6 +51,6 @@ 06/01 dx price -scale_x_date(labels = date_format("%m/%d")) +scale_x_date(labels = label_date("%m/%d")) diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg index fa832b94e5..1748ed74f5 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg @@ -51,6 +51,6 @@ 22 week price -scale_x_date(labels = date_format("%W"), "week") +scale_x_date(labels = label_date("%W"), "week") diff --git a/tests/testthat/test-fortify.R b/tests/testthat/test-fortify.R index 43b7adb74c..03980c19c1 100644 --- a/tests/testthat/test-fortify.R +++ b/tests/testthat/test-fortify.R @@ -1,5 +1,8 @@ test_that("spatial polygons have correct ordering", { - skip_if_not_installed("sp") + suppressPackageStartupMessages({ + skip_if_not_installed("sp") + }) + make_square <- function(x = 0, y = 0, height = 1, width = 1){ delx <- width/2 @@ -30,12 +33,14 @@ test_that("spatial polygons have correct ordering", { polys2_sp <- sp::SpatialPolygons(polys2) fake_sp2 <- sp::SpatialPolygonsDataFrame(polys2_sp, fake_data) lifecycle::expect_deprecated( - expected <- fortify(fake_sp2) + # supressing: Regions defined for each Polygons + expected <- suppressMessages(fortify(fake_sp2)) ) expected <- expected[order(expected$id, expected$order), ] lifecycle::expect_deprecated( - actual <- fortify(fake_sp) + # supressing: Regions defined for each Polygons + actual <- suppressMessages(fortify(fake_sp)) ) # the levels are different, so these columns need to be converted to character to compare diff --git a/tests/testthat/test-function-args.R b/tests/testthat/test-function-args.R index 6be2567689..2a78bf9f50 100644 --- a/tests/testthat/test-function-args.R +++ b/tests/testthat/test-function-args.R @@ -50,8 +50,8 @@ test_that("stat_xxx and StatXxx$compute_panel arg defaults match", { stat_fun_names, c("stat_function", "stat_sf") ) - # Remove stat_spoke as it has been deprecated - stat_fun_names <- setdiff(stat_fun_names, "stat_spoke") + # Remove deprecated stats + stat_fun_names <- setdiff(stat_fun_names, c("stat_spoke", "stat_summary2d")) # For each stat_xxx function and the corresponding StatXxx$compute_panel and # StatXxx$compute_group functions, make sure that if they have same args, that diff --git a/tests/testthat/test-geom-dotplot.R b/tests/testthat/test-geom-dotplot.R index a095158937..69b7d65a75 100644 --- a/tests/testthat/test-geom-dotplot.R +++ b/tests/testthat/test-geom-dotplot.R @@ -63,7 +63,7 @@ test_that("NA's result in warning from stat_bindot", { test_that("when binning on y-axis, limits depend on the panel", { p <- ggplot(mtcars, aes(factor(cyl), mpg)) + - geom_dotplot(binaxis='y') + geom_dotplot(binaxis='y', binwidth = 1/30 * diff(range(mtcars$mpg))) b1 <- ggplot_build(p + facet_wrap(~am)) b2 <- ggplot_build(p + facet_wrap(~am, scales = "free_y")) @@ -77,10 +77,10 @@ test_that("when binning on y-axis, limits depend on the panel", { test_that("weight aesthetic is checked", { p <- ggplot(mtcars, aes(x = mpg, weight = gear/3)) + - geom_dotplot() + geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg))) expect_snapshot_warning(ggplot_build(p)) p <- ggplot(mtcars, aes(x = mpg, weight = -gear)) + - geom_dotplot() + geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg))) expect_snapshot_warning(ggplot_build(p)) }) diff --git a/tests/testthat/test-geom-hline-vline-abline.R b/tests/testthat/test-geom-hline-vline-abline.R index 61510a3c7c..b637cd0a2f 100644 --- a/tests/testthat/test-geom-hline-vline-abline.R +++ b/tests/testthat/test-geom-hline-vline-abline.R @@ -9,12 +9,11 @@ test_that("check h/v/abline transformed on basic projections", { geom_vline(xintercept = 3, colour = "red") + geom_hline(yintercept = 3, colour = "blue") + geom_abline(intercept = 0, slope = 1, colour = "purple") + - labs(x = NULL, y = NULL) + - coord_cartesian(expand = FALSE) + labs(x = NULL, y = NULL) expect_doppelganger( "cartesian lines intersect mid-bars", - plot + plot + coord_cartesian(expand = FALSE) ) expect_doppelganger( "flipped lines intersect mid-bars", @@ -34,11 +33,10 @@ test_that("curved lines in map projections", { nzmap <- ggplot(nz, aes(long, lat, group = group)) + geom_path() + geom_hline(yintercept = -38.6) + # roughly Taupo - geom_vline(xintercept = 176) + - coord_map() + geom_vline(xintercept = 176) expect_doppelganger("straight lines in mercator", - nzmap + nzmap + coord_map() ) expect_doppelganger("lines curved in azequalarea", nzmap + coord_map(projection = 'azequalarea', orientation = c(-36.92, 174.6, 0)) diff --git a/tests/testthat/test-geom-quantile.R b/tests/testthat/test-geom-quantile.R index 710f88436d..d9eaf84184 100644 --- a/tests/testthat/test-geom-quantile.R +++ b/tests/testthat/test-geom-quantile.R @@ -13,7 +13,7 @@ test_that("geom_quantile matches quantile regression", { y = x^2 + 0.5 * rnorm(10) ) - ps <- ggplot(df, aes(x, y)) + geom_quantile() + ps <- ggplot(df, aes(x, y)) + geom_quantile(formula = y ~ x) quants <- c(0.25, 0.5, 0.75) diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index ca57bd2e38..e71df88485 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -8,11 +8,13 @@ test_that("data is ordered by x", { }) test_that("geom_smooth works in both directions", { - p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth() + p <- ggplot(mpg, aes(displ, hwy)) + + geom_smooth(method = 'loess', formula = y ~ x) x <- layer_data(p) expect_false(x$flipped_aes[1]) - p <- ggplot(mpg, aes(hwy, displ)) + geom_smooth(orientation = "y") + p <- ggplot(mpg, aes(hwy, displ)) + + geom_smooth(orientation = "y", method = 'loess', formula = y ~ x) y <- layer_data(p) expect_true(y$flipped_aes[1]) @@ -103,11 +105,11 @@ test_that("geom_smooth() works with alternative stats", { expect_doppelganger("ribbon turned on in geom_smooth", { ggplot(df, aes(x, y, color = fill, fill = fill)) + - geom_smooth(stat = "summary") # ribbon on by default + geom_smooth(stat = "summary", fun.data = mean_se) # ribbon on by default }) expect_doppelganger("ribbon turned off in geom_smooth", { ggplot(df, aes(x, y, color = fill, fill = fill)) + - geom_smooth(stat = "summary", se = FALSE) # ribbon is turned off via `se = FALSE` + geom_smooth(stat = "summary", se = FALSE, fun.data = mean_se) # ribbon is turned off via `se = FALSE` }) }) diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 58ae5051bd..b0507cf7ae 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -26,10 +26,13 @@ test_that("unknown aesthetics create warning", { }) test_that("invalid aesthetics throws errors", { - p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data)) - expect_snapshot_error(ggplot_build(p)) - p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data))) - expect_snapshot_error(ggplot_build(p)) + # We want to test error and ignore the scale search message + suppressMessages({ + p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data)) + expect_snapshot_error(ggplot_build(p)) + p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data))) + expect_snapshot_error(ggplot_build(p)) + }) }) test_that("unknown NULL aesthetic doesn't create warning (#1909)", { @@ -57,8 +60,12 @@ test_that("missing aesthetics trigger informative error", { test_that("function aesthetics are wrapped with after_stat()", { df <- data_frame(x = 1:10) - expect_snapshot_error( - ggplot_build(ggplot(df, aes(colour = density, fill = density)) + geom_point()) + suppressMessages( + expect_snapshot_error( + ggplot_build( + ggplot(df, aes(colour = density, fill = density)) + geom_point() + ) + ) ) }) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index 24aa21ec6a..d15a19fcff 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.R @@ -9,11 +9,11 @@ test_that("stat_bin throws error when wrong combination of aesthetic is present" }) test_that("stat_bin works in both directions", { - p <- ggplot(mpg, aes(hwy)) + stat_bin() + p <- ggplot(mpg, aes(hwy)) + stat_bin(bins = 30) x <- layer_data(p) expect_false(x$flipped_aes[1]) - p <- ggplot(mpg, aes(y = hwy)) + stat_bin() + p <- ggplot(mpg, aes(y = hwy)) + stat_bin(bins = 30) y <- layer_data(p) expect_true(y$flipped_aes[1]) @@ -81,7 +81,7 @@ test_that("breaks are transformed by the scale", { test_that("geom_histogram() can be drawn over a 0-width range (#3043)", { df <- data_frame(x = rep(1, 100)) - out <- layer_data(ggplot(df, aes(x)) + geom_histogram()) + out <- layer_data(ggplot(df, aes(x)) + geom_histogram(bins = 30)) expect_equal(nrow(out), 1) expect_equal(out$xmin, 0.95) diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R index 04dbd79f52..0619ccc707 100644 --- a/tests/testthat/test-utilities-checks.R +++ b/tests/testthat/test-utilities-checks.R @@ -2,7 +2,8 @@ test_that("check_device checks R versions correctly", { # Most widely supported device - withr::local_pdf() + file <- withr::local_tempfile(fileext = ".pdf") + withr::local_pdf(file) # R 4.0.0 doesn't support any new features with_mocked_bindings( @@ -45,7 +46,8 @@ test_that("check_device finds device capabilities", { getRversion() < "4.2.0", "R version < 4.2.0 does doesn't have proper `dev.capabilities()`." ) - withr::local_pdf() + file <- withr::local_tempfile(fileext = ".pdf") + withr::local_pdf(file) with_mocked_bindings( dev.capabilities = function() list(clippingPaths = TRUE), expect_true(check_device("clippingPaths")), From 15bde2fd5616d86838648992cb2b22b53bae95db Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 6 Dec 2023 12:18:14 +0100 Subject: [PATCH 10/22] Enable horizontal margins on (sub)title/caption (#5545) * enable x-margins * add news bullet --- NEWS.md | 3 +++ R/plot-build.R | 15 ++++++++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 992d5cc395..cabdc6940b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* The plot's title, subtitle and caption now obey horizontal text margins + (#5533). + * New `guide_axis_stack()` to combine other axis guides on top of one another. * New `guide_custom()` function for drawing custom graphical objects (grobs) diff --git a/R/plot-build.R b/R/plot-build.R index 7fa0a89be3..51208d20dd 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -265,15 +265,24 @@ ggplot_gtable.ggplot_built <- function(data) { } # Title - title <- element_render(theme, "plot.title", plot$labels$title, margin_y = TRUE) + title <- element_render( + theme, "plot.title", plot$labels$title, + margin_y = TRUE, margin_x = TRUE + ) title_height <- grobHeight(title) # Subtitle - subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, margin_y = TRUE) + subtitle <- element_render( + theme, "plot.subtitle", plot$labels$subtitle, + margin_y = TRUE, margin_x = TRUE + ) subtitle_height <- grobHeight(subtitle) # whole plot annotation - caption <- element_render(theme, "plot.caption", plot$labels$caption, margin_y = TRUE) + caption <- element_render( + theme, "plot.caption", plot$labels$caption, + margin_y = TRUE, margin_x = TRUE + ) caption_height <- grobHeight(caption) # positioning of title and subtitle is governed by plot.title.position From ad540b77d0fb1ed2e3e349089cd8acb5c1edeb78 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 10:14:49 +0100 Subject: [PATCH 11/22] Barebones support for `` fills. (#5299) * Write pattern utilities * Intercept non-list patterns * Support pattern fills in geoms * Support pattern fills in keys * Note that `geom_raster()` cannot use pattern fills * More informative call in error message * Write tests * Document * Some version protections * Use device checker * Set white alpha mask * Clarify error message * deal with unavailable functions/arguments * typo * Also handle unlisted pattern * Invert viewport backport * `geom_raster()` throws error when fill is pattern * device check warns instead of aborts * reimplement `pattern_alpha` as S3 generic + methods * accept new snapshot * Add news bullet --- DESCRIPTION | 1 + NAMESPACE | 6 + NEWS.md | 5 + R/backports.R | 23 +++ R/geom-.R | 4 + R/geom-boxplot.R | 2 +- R/geom-dotplot.R | 2 +- R/geom-hex.R | 2 +- R/geom-label.R | 2 +- R/geom-map.R | 2 +- R/geom-point.R | 2 +- R/geom-polygon.R | 4 +- R/geom-raster.R | 4 + R/geom-rect.R | 2 +- R/geom-ribbon.R | 2 +- R/geom-tile.R | 3 +- R/legend-draw.R | 12 +- R/utilities-patterns.R | 115 +++++++++++++ man/fill_alpha.Rd | 33 ++++ man/geom_tile.Rd | 3 +- man/pattern_alpha.Rd | 22 +++ tests/testthat/_snaps/geom-raster.md | 7 + tests/testthat/_snaps/patterns.md | 8 + .../patterns/pattern-fills-no-alpha.svg | 115 +++++++++++++ .../patterns/pattern-fills-through-scale.svg | 155 ++++++++++++++++++ .../patterns/pattern-fills-with-alpha.svg | 120 ++++++++++++++ .../_snaps/patterns/single-pattern-fill.svg | 120 ++++++++++++++ tests/testthat/test-geom-raster.R | 7 + tests/testthat/test-patterns.R | 118 +++++++++++++ 29 files changed, 883 insertions(+), 18 deletions(-) create mode 100644 R/utilities-patterns.R create mode 100644 man/fill_alpha.Rd create mode 100644 man/pattern_alpha.Rd create mode 100644 tests/testthat/_snaps/patterns.md create mode 100644 tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg create mode 100644 tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg create mode 100644 tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg create mode 100644 tests/testthat/_snaps/patterns/single-pattern-fill.svg create mode 100644 tests/testthat/test-patterns.R diff --git a/DESCRIPTION b/DESCRIPTION index c5c8af640e..1481517272 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -275,6 +275,7 @@ Collate: 'utilities-grid.R' 'utilities-help.R' 'utilities-matrix.R' + 'utilities-patterns.R' 'utilities-resolution.R' 'utilities-tidy-eval.R' 'zxx.R' diff --git a/NAMESPACE b/NAMESPACE index 1e43aa78ad..b15bde6e2f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -95,6 +95,10 @@ S3method(makeContext,dotstackGrob) S3method(merge_element,default) S3method(merge_element,element) S3method(merge_element,element_blank) +S3method(pattern_alpha,GridPattern) +S3method(pattern_alpha,GridTilingPattern) +S3method(pattern_alpha,default) +S3method(pattern_alpha,list) S3method(plot,ggplot) S3method(predictdf,default) S3method(predictdf,glm) @@ -354,6 +358,7 @@ export(expr) export(facet_grid) export(facet_null) export(facet_wrap) +export(fill_alpha) export(find_panel) export(flip_data) export(flipped_names) @@ -476,6 +481,7 @@ export(new_guide) export(old_guide) export(panel_cols) export(panel_rows) +export(pattern_alpha) export(position_dodge) export(position_dodge2) export(position_fill) diff --git a/NEWS.md b/NEWS.md index cabdc6940b..7f984112bc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* The `fill` aesthetic in many geoms now accepts grid's patterns and gradients. + For developers of layer extensions, this feature can be enabled by switching + from `fill = alpha(fill, alpha)` to `fill = fill_alpha(fill, alpha)` when + providing fills to `grid::gpar()` (@teunbrand, #3997). + * The plot's title, subtitle and caption now obey horizontal text margins (#5533). diff --git a/R/backports.R b/R/backports.R index 4679be5680..0fe48cc3ac 100644 --- a/R/backports.R +++ b/R/backports.R @@ -22,3 +22,26 @@ if (getRversion() < "3.5") { isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x isTRUE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && x } + +version_unavailable <- function(...) { + fun <- as_label(current_call()[[1]]) + cli::cli_abort("{.fn {fun}} is not available in R version {getRversion()}.") +} + +# Ignore mask argument if on lower R version (<= 4.1) +viewport <- function(..., mask) grid::viewport(...) +pattern <- version_unavailable +as.mask <- version_unavailable +on_load({ + if ("mask" %in% fn_fmls_names(grid::viewport)) { + viewport <- grid::viewport + } + # Replace version unavailable functions if found + if ("pattern" %in% getNamespaceExports("grid")) { + pattern <- grid::pattern + } + if ("as.mask" %in% getNamespaceExports("grid")) { + as.mask <- grid::as.mask + } +}) + diff --git a/R/geom-.R b/R/geom-.R index 9a6966e15b..6d4ed6fc55 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -126,6 +126,10 @@ Geom <- ggproto("Geom", deprecate_soft0("3.4.0", I("Using the `size` aesthetic in this geom"), I("`linewidth` in the `default_aes` field and elsewhere")) default_aes$linewidth <- default_aes$size } + if (is_pattern(params$fill)) { + params$fill <- list(params$fill) + } + # Fill in missing aesthetics with their defaults missing_aes <- setdiff(names(default_aes), names(data)) diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index b4f7777e6f..289c10cd97 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -239,7 +239,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, colour = data$colour, linewidth = data$linewidth, linetype = data$linetype, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), group = data$group ) diff --git a/R/geom-dotplot.R b/R/geom-dotplot.R index 802a717c28..120fb80109 100644 --- a/R/geom-dotplot.R +++ b/R/geom-dotplot.R @@ -294,7 +294,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, stackposition = tdata$stackpos, stackdir = stackdir, stackratio = stackratio, default.units = "npc", gp = gpar(col = alpha(tdata$colour, tdata$alpha), - fill = alpha(tdata$fill, tdata$alpha), + fill = fill_alpha(tdata$fill, tdata$alpha), lwd = tdata$stroke, lty = tdata$linetype, lineend = lineend)) ) diff --git a/R/geom-hex.R b/R/geom-hex.R index a882979bf1..e3027096f1 100644 --- a/R/geom-hex.R +++ b/R/geom-hex.R @@ -90,7 +90,7 @@ GeomHex <- ggproto("GeomHex", Geom, coords$x, coords$y, gp = gpar( col = data$colour, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), lwd = data$linewidth * .pt, lty = data$linetype, lineend = lineend, diff --git a/R/geom-label.R b/R/geom-label.R index 41ba35f2fc..d83434b386 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -103,7 +103,7 @@ GeomLabel <- ggproto("GeomLabel", Geom, ), rect.gp = gpar( col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour, - fill = alpha(row$fill, row$alpha), + fill = fill_alpha(row$fill, row$alpha), lwd = label.size * .pt ) ) diff --git a/R/geom-map.R b/R/geom-map.R index 7ecfd09e0b..01024ebeff 100644 --- a/R/geom-map.R +++ b/R/geom-map.R @@ -146,7 +146,7 @@ GeomMap <- ggproto("GeomMap", GeomPolygon, polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id, gp = gpar( col = data$colour, - fill = alpha(data$fill, data$alpha), + fill = fill_alpha(data$fill, data$alpha), lwd = data$linewidth * .pt, lineend = lineend, linejoin = linejoin, diff --git a/R/geom-point.R b/R/geom-point.R index ef9df0b652..1b39a11d46 100644 --- a/R/geom-point.R +++ b/R/geom-point.R @@ -131,7 +131,7 @@ GeomPoint <- ggproto("GeomPoint", Geom, pch = coords$shape, gp = gpar( col = alpha(coords$colour, coords$alpha), - fill = alpha(coords$fill, coords$alpha), + fill = fill_alpha(coords$fill, coords$alpha), # Stroke is added around the outside of the point fontsize = coords$size * .pt + stroke_size * .stroke / 2, lwd = coords$stroke * .stroke / 2 diff --git a/R/geom-polygon.R b/R/geom-polygon.R index 2e1efb835c..c644d9daad 100644 --- a/R/geom-polygon.R +++ b/R/geom-polygon.R @@ -132,7 +132,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, id = munched$group, gp = gpar( col = first_rows$colour, - fill = alpha(first_rows$fill, first_rows$alpha), + fill = fill_alpha(first_rows$fill, first_rows$alpha), lwd = first_rows$linewidth * .pt, lty = first_rows$linetype, lineend = lineend, @@ -163,7 +163,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, rule = rule, gp = gpar( col = first_rows$colour, - fill = alpha(first_rows$fill, first_rows$alpha), + fill = fill_alpha(first_rows$fill, first_rows$alpha), lwd = first_rows$linewidth * .pt, lty = first_rows$linetype, lineend = lineend, diff --git a/R/geom-raster.R b/R/geom-raster.R index c3709a7d98..2cd591d879 100644 --- a/R/geom-raster.R +++ b/R/geom-raster.R @@ -102,6 +102,10 @@ GeomRaster <- ggproto("GeomRaster", Geom, nrow <- max(y_pos) + 1 ncol <- max(x_pos) + 1 + if (is.list(data$fill) && is_pattern(data$fill[[1]])) { + cli::cli_abort("{.fn {snake_class(self)}} cannot render pattern fills.") + } + raster <- matrix(NA_character_, nrow = nrow, ncol = ncol) raster[cbind(nrow - y_pos, x_pos + 1)] <- alpha(data$fill, data$alpha) diff --git a/R/geom-rect.R b/R/geom-rect.R index 1d4108345d..d39978897a 100644 --- a/R/geom-rect.R +++ b/R/geom-rect.R @@ -59,7 +59,7 @@ GeomRect <- ggproto("GeomRect", Geom, just = c("left", "top"), gp = gpar( col = coords$colour, - fill = alpha(coords$fill, coords$alpha), + fill = fill_alpha(coords$fill, coords$alpha), lwd = coords$linewidth * .pt, lty = coords$linetype, linejoin = linejoin, diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R index ed6696bb39..d93df77850 100644 --- a/R/geom-ribbon.R +++ b/R/geom-ribbon.R @@ -183,7 +183,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, munched_poly$x, munched_poly$y, id = munched_poly$id, default.units = "native", gp = gpar( - fill = alpha(aes$fill, aes$alpha), + fill = fill_alpha(aes$fill, aes$alpha), col = if (is_full_outline) aes$colour else NA, lwd = if (is_full_outline) aes$linewidth * .pt else 0, lty = if (is_full_outline) aes$linetype else 1, diff --git a/R/geom-tile.R b/R/geom-tile.R index 02a696f430..8bc95fef12 100644 --- a/R/geom-tile.R +++ b/R/geom-tile.R @@ -5,7 +5,8 @@ #' corners (`xmin`, `xmax`, `ymin` and `ymax`), while #' `geom_tile()` uses the center of the tile and its size (`x`, #' `y`, `width`, `height`). `geom_raster()` is a high -#' performance special case for when all the tiles are the same size. +#' performance special case for when all the tiles are the same size, and no +#' pattern fills are applied. #' #' @eval rd_aesthetics("geom", "tile", "Note that `geom_raster()` ignores `colour`.") #' @inheritParams layer diff --git a/R/legend-draw.R b/R/legend-draw.R index 5f8c202f07..e039e97ac3 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -38,7 +38,7 @@ draw_key_point <- function(data, params, size) { pch = data$shape, gp = gpar( col = alpha(data$colour %||% "black", data$alpha), - fill = alpha(data$fill %||% "black", data$alpha), + fill = fill_alpha(data$fill %||% "black", data$alpha), fontsize = (data$size %||% 1.5) * .pt + stroke_size * .stroke / 2, lwd = stroke_size * .stroke / 2 ) @@ -63,7 +63,7 @@ draw_key_abline <- function(data, params, size) { draw_key_rect <- function(data, params, size) { rectGrob(gp = gpar( col = NA, - fill = alpha(data$fill %||% data$colour %||% "grey20", data$alpha), + fill = fill_alpha(data$fill %||% data$colour %||% "grey20", data$alpha), lty = data$linetype %||% 1 )) } @@ -81,7 +81,7 @@ draw_key_polygon <- function(data, params, size) { height = unit(1, "npc") - unit(lwd, "mm"), gp = gpar( col = data$colour %||% NA, - fill = alpha(data$fill %||% "grey20", data$alpha), + fill = fill_alpha(data$fill %||% "grey20", data$alpha), lty = data$linetype %||% 1, lwd = lwd * .pt, linejoin = params$linejoin %||% "mitre", @@ -100,7 +100,7 @@ draw_key_blank <- function(data, params, size) { draw_key_boxplot <- function(data, params, size) { gp <- gpar( col = data$colour %||% "grey20", - fill = alpha(data$fill %||% "white", data$alpha), + fill = fill_alpha(data$fill %||% "white", data$alpha), lwd = (data$linewidth %||% 0.5) * .pt, lty = data$linetype %||% 1, lineend = params$lineend %||% "butt", @@ -131,7 +131,7 @@ draw_key_boxplot <- function(data, params, size) { draw_key_crossbar <- function(data, params, size) { gp <- gpar( col = data$colour %||% "grey20", - fill = alpha(data$fill %||% "white", data$alpha), + fill = fill_alpha(data$fill %||% "white", data$alpha), lwd = (data$linewidth %||% 0.5) * .pt, lty = data$linetype %||% 1, lineend = params$lineend %||% "butt", @@ -195,7 +195,7 @@ draw_key_dotplot <- function(data, params, size) { pch = 21, gp = gpar( col = alpha(data$colour %||% "black", data$alpha), - fill = alpha(data$fill %||% "black", data$alpha), + fill = fill_alpha(data$fill %||% "black", data$alpha), lty = data$linetype %||% 1, lineend = params$lineend %||% "butt" ) diff --git a/R/utilities-patterns.R b/R/utilities-patterns.R new file mode 100644 index 0000000000..e7cdd308bc --- /dev/null +++ b/R/utilities-patterns.R @@ -0,0 +1,115 @@ + +#' Modify fill transparency +#' +#' This works much like [alpha()][scales::alpha] in that it modifies the +#' transparency of fill colours. It differs in that `fill_alpha()` also attempts +#' to set the transparency of `` objects. +#' +#' @param fill A fill colour given as a `character` or `integer` vector, or as a +#' (list of) `` object(s). +#' @param alpha A transparency value between 0 (transparent) and 1 (opaque), +#' parallel to `fill`. +#' +#' @return A `character` vector of colours, or list of `` objects. +#' @export +#' @keywords internal +#' +#' @examples +#' # Typical colour input +#' fill_alpha("red", 0.5) +#' +#' if (utils::packageVersion("grid") > "4.2") { +#' # Pattern input +#' fill_alpha(list(grid::linearGradient()), 0.5) +#' } +fill_alpha <- function(fill, alpha) { + if (!is.list(fill)) { + # Happy path for no patterns + return(alpha(fill, alpha)) + } + if (is_pattern(fill) || any(vapply(fill, is_pattern, logical(1)))) { + check_device("patterns", action = "warn") + fill <- pattern_alpha(fill, alpha) + return(fill) + } else { + # We are either dealing with faulty fill specification, or we have a legend + # key that is trying to draw a single colour. It can be given that colour + # as a list due to patterns in other keys. + msg <- paste0( + "{.field fill} must be a vector of colours or list of ", + "{.cls GridPattern} objects." + ) + # If single colour list, try applying `alpha()` + fill <- try_fetch( + Map(alpha, colour = fill, alpha = alpha), + error = function(cnd) { + cli::cli_abort(msg, call = expr(fill_alpha())) + } + ) + # `length(input)` must be same as `length(output)` + if (!all(lengths(fill) == 1)) { + cli::cli_abort(msg) + } + return(unlist(fill)) + } +} + +# Similar to grid:::is.pattern +is_pattern <- function(x) { + inherits(x, "GridPattern") +} + +#' Modify transparency for patterns +#' +#' This generic allows you to add your own methods for adding transparency to +#' pattern-like objects. +#' +#' @param x Object to be interpreted as pattern. +#' @param alpha A `numeric` vector between 0 and 1. If `NA`, alpha values +#' are preserved. +#' +#' @return `x` with modified transparency +#' @export +#' @keywords internal +pattern_alpha <- function(x, alpha) { + UseMethod("pattern_alpha") +} + +#' @export +pattern_alpha.default <- function(x, alpha) { + if (!is.atomic(x)) { + cli::cli_abort("Can't apply {.arg alpha} to {obj_type_friendly(x)}.") + } + pattern(rectGrob(), gp = gpar(fill = alpha(x, alpha))) +} + +#' @export +pattern_alpha.GridPattern <- function(x, alpha) { + x$colours <- alpha(x$colours, alpha[1]) + x +} + +#' @export +pattern_alpha.GridTilingPattern <- function(x, alpha) { + if (all(is.na(alpha) | alpha == 1)) { + return(x) + } + check_device("alpha_masks", "warn") + grob <- env_get(environment(x$f), "grob") + mask <- as.mask(rectGrob(gp = gpar(fill = alpha("white", alpha)))) + if (is.null(grob$vp)) { + grob$vp <- viewport(mask = mask) + } else { + grob$vp <- editViewport(grob$vp, mask = mask) + } + new_env <- new.env(parent = environment(x$f)) + env_bind(new_env, grob = grob) + environment(x$f) <- new_env + x +} + +#' @export +pattern_alpha.list <- function(x, alpha) { + Map(pattern_alpha, x = x, alpha = alpha) +} + diff --git a/man/fill_alpha.Rd b/man/fill_alpha.Rd new file mode 100644 index 0000000000..8902d4cd38 --- /dev/null +++ b/man/fill_alpha.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-patterns.R +\name{fill_alpha} +\alias{fill_alpha} +\title{Modify fill transparency} +\usage{ +fill_alpha(fill, alpha) +} +\arguments{ +\item{fill}{A fill colour given as a \code{character} or \code{integer} vector, or as a +(list of) \verb{} object(s).} + +\item{alpha}{A transparency value between 0 (transparent) and 1 (opaque), +parallel to \code{fill}.} +} +\value{ +A \code{character} vector of colours, or list of \verb{} objects. +} +\description{ +This works much like \link[scales:alpha]{alpha()} in that it modifies the +transparency of fill colours. It differs in that \code{fill_alpha()} also attempts +to set the transparency of \verb{} objects. +} +\examples{ +# Typical colour input +fill_alpha("red", 0.5) + +if (utils::packageVersion("grid") > "4.2") { + # Pattern input + fill_alpha(list(grid::linearGradient()), 0.5) +} +} +\keyword{internal} diff --git a/man/geom_tile.Rd b/man/geom_tile.Rd index 39a6128cf7..00903da7f6 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -109,7 +109,8 @@ parameterised differently: \code{geom_rect()} uses the locations of the four corners (\code{xmin}, \code{xmax}, \code{ymin} and \code{ymax}), while \code{geom_tile()} uses the center of the tile and its size (\code{x}, \code{y}, \code{width}, \code{height}). \code{geom_raster()} is a high -performance special case for when all the tiles are the same size. +performance special case for when all the tiles are the same size, and no +pattern fills are applied. } \details{ \code{geom_rect()} and \code{geom_tile()}'s respond differently to scale diff --git a/man/pattern_alpha.Rd b/man/pattern_alpha.Rd new file mode 100644 index 0000000000..3c481d23b1 --- /dev/null +++ b/man/pattern_alpha.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities-patterns.R +\name{pattern_alpha} +\alias{pattern_alpha} +\title{Modify transparency for patterns} +\usage{ +pattern_alpha(x, alpha) +} +\arguments{ +\item{x}{Object to be interpreted as pattern.} + +\item{alpha}{A \code{numeric} vector between 0 and 1. If \code{NA}, alpha values +are preserved.} +} +\value{ +\code{x} with modified transparency +} +\description{ +This generic allows you to add your own methods for adding transparency to +pattern-like objects. +} +\keyword{internal} diff --git a/tests/testthat/_snaps/geom-raster.md b/tests/testthat/_snaps/geom-raster.md index 90bdd9dc0b..16da7d9d54 100644 --- a/tests/testthat/_snaps/geom-raster.md +++ b/tests/testthat/_snaps/geom-raster.md @@ -21,3 +21,10 @@ Caused by error in `draw_panel()`: ! `geom_raster()` only works with `coord_cartesian()`. +# geom_raster() fails with pattern fills + + Problem while converting geom to grob. + i Error occurred in the 1st layer. + Caused by error in `draw_panel()`: + ! `geom_raster()` cannot render pattern fills. + diff --git a/tests/testthat/_snaps/patterns.md b/tests/testthat/_snaps/patterns.md new file mode 100644 index 0000000000..5a9374a4d6 --- /dev/null +++ b/tests/testthat/_snaps/patterns.md @@ -0,0 +1,8 @@ +# fill_alpha works as expected + + fill must be a vector of colours or list of objects. + +--- + + fill must be a vector of colours or list of objects. + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg b/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg new file mode 100644 index 0000000000..bdf29df500 --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-no-alpha.svg @@ -0,0 +1,115 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +pattern fills, no alpha + + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg b/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg new file mode 100644 index 0000000000..a703f46c91 --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-through-scale.svg @@ -0,0 +1,155 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y + +x + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C +D +pattern fills through scale + + diff --git a/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg b/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg new file mode 100644 index 0000000000..964a5b714b --- /dev/null +++ b/tests/testthat/_snaps/patterns/pattern-fills-with-alpha.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +pattern fills, with alpha + + diff --git a/tests/testthat/_snaps/patterns/single-pattern-fill.svg b/tests/testthat/_snaps/patterns/single-pattern-fill.svg new file mode 100644 index 0000000000..9126ab0c7f --- /dev/null +++ b/tests/testthat/_snaps/patterns/single-pattern-fill.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + +A +B +C +D +x +y +single pattern fill + + diff --git a/tests/testthat/test-geom-raster.R b/tests/testthat/test-geom-raster.R index 081abc5c20..2dfa1106e3 100644 --- a/tests/testthat/test-geom-raster.R +++ b/tests/testthat/test-geom-raster.R @@ -9,6 +9,13 @@ test_that("geom_raster() checks input and coordinate system", { expect_snapshot_error(ggplotGrob(p)) }) +test_that("geom_raster() fails with pattern fills", { + skip_if_not(getRversion() > "4.2", message = "pattern fills are unavailalbe") + df <- data.frame(x = 1) + p <- ggplot(df, aes(x, x)) + geom_raster(fill = linearGradient()) + expect_snapshot_error(ggplotGrob(p)) +}) + # Visual tests ------------------------------------------------------------ test_that("geom_raster draws correctly", { diff --git a/tests/testthat/test-patterns.R b/tests/testthat/test-patterns.R new file mode 100644 index 0000000000..8e2b64d82e --- /dev/null +++ b/tests/testthat/test-patterns.R @@ -0,0 +1,118 @@ +test_that("fill_alpha works as expected", { + + expect_snapshot_error( + fill_alpha(data.frame(x = 1:10, y = LETTERS[1:10]), 0.5) + ) + + expect_snapshot_error( + fill_alpha(list(list("red", "blue"), list("green", "orange")), 0.5) + ) + + # Vector input + expect_identical( + fill_alpha(c("red", "green"), 0.5), + c("#FF000080", "#00FF0080") + ) + + # List input + expect_identical( + fill_alpha(list("red", "green"), 0.5), + c("#FF000080", "#00FF0080") + ) + + skip_if_not_installed("grid", "4.2.0") + + # Linear gradients + expect_identical( + fill_alpha(list(linearGradient()), 0.5)[[1]]$colours, + c("#00000080", "#FFFFFF80") + ) + + # Radial gradients + expect_identical( + fill_alpha(list(radialGradient()), 0.5)[[1]]$colours, + c("#00000080", "#FFFFFF80") + ) + + # Tiled pattern + pat <- pattern( + rectGrob(c(0.25, 0.75), c(0.25, 0.75), width = 0.5, height = 0.5, + gp = gpar(fill = "black", col = NA)), + width = unit(1, "cm"), height = unit(1, "cm"), + extend = "repeat" + ) + # Constructed with empty viewport + expect_null(environment(pat$f)$grob$vp) + + ans <- fill_alpha(list(pat), 0.5) + + # Viewport should have mask + expect_s3_class(environment(ans[[1]]$f)$grob$vp$mask, "GridMask") + # Should not have altered original environment + expect_null(environment(pat$f)$grob$vp) + + # Handles plain, unlisted patterns + expect_identical( + fill_alpha(linearGradient(), 0.5)$colours, + c("#00000080", "#FFFFFF80") + ) +}) + +test_that("geoms can use pattern fills", { + + skip_if_not_installed("grid", "4.2.0") + skip_if_not_installed("svglite", "2.1.0") + + # Workaround for vdiffr's lack of pattern support + # See also https://github.com/r-lib/vdiffr/issues/132 + custom_svg <- function(plot, file, title = "") { + svglite::svglite(file) + on.exit(grDevices::dev.off()) + print( + plot + ggtitle(title) + theme_test() + ) + } + + patterns <- list( + linearGradient(group = FALSE), + radialGradient(group = FALSE), + pattern( + rectGrob(c(0.25, 0.75), c(0.25, 0.75), width = 0.5, height = 0.5, + gp = gpar(fill = "black", col = NA)), + width = unit(1, "cm"), height = unit(1, "cm"), + extend = "repeat" + ), + "black" + ) + + df <- data.frame(x = LETTERS[1:4], y = 2:5) + + expect_doppelganger( + "single pattern fill", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns[3]), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills, no alpha", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills, with alpha", + ggplot(df, aes(x, y)) + + geom_col(fill = patterns, alpha = c(0.8, 0.6, 0.4, 0.2)), + writer = custom_svg + ) + + expect_doppelganger( + "pattern fills through scale", + ggplot(df, aes(x, y, fill = x)) + + geom_col() + + scale_fill_manual(values = rev(patterns)), + writer = custom_svg + ) +}) From b0e75867c213579aa17c9a64a4ee7d12251ec9f6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 10:46:40 +0100 Subject: [PATCH 12/22] Ignoring `AsIs` objects (again) (#5477) * Write some utility functions * ignore data around scale operations * Simple test for expose/ignore * Add news bullet * use '.'-prefix * export ignore/expose functions --- NAMESPACE | 2 ++ NEWS.md | 5 +++ R/plot-build.R | 4 +++ R/utilities.R | 63 +++++++++++++++++++++++++++++++++ man/ignoring_data.Rd | 35 ++++++++++++++++++ tests/testthat/test-utilities.R | 18 ++++++++++ 6 files changed, 127 insertions(+) create mode 100644 man/ignoring_data.Rd diff --git a/NAMESPACE b/NAMESPACE index b15bde6e2f..6a9893e917 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -152,6 +152,8 @@ S3method(widthDetails,zeroGrob) export("%+%") export("%+replace%") export(.data) +export(.expose_data) +export(.ignore_data) export(.pt) export(.stroke) export(AxisSecondary) diff --git a/NEWS.md b/NEWS.md index 7f984112bc..a529b46d31 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* Plot scales now ignore `AsIs` objects constructed with `I(x)`, instead of + invoking the identity scale. This allows these columns to co-exist with other + layers that need a non-identity scale for the same aesthetic. Also, it makes + it easy to specify relative positions (@teunbrand, #5142). + * The `fill` aesthetic in many geoms now accepts grid's patterns and gradients. For developers of layer extensions, this feature can be enabled by switching from `fill = alpha(fill, alpha)` to `fill = fill_alpha(fill, alpha)` when diff --git a/R/plot-build.R b/R/plot-build.R index 51208d20dd..cf3ff3fdcd 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -51,6 +51,7 @@ ggplot_build.ggplot <- function(plot) { # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics") + data <- .ignore_data(data) # Transform all scales data <- lapply(data, scales$transform_df) @@ -62,6 +63,7 @@ ggplot_build.ggplot <- function(plot) { layout$train_position(data, scale_x(), scale_y()) data <- layout$map_position(data) + data <- .expose_data(data) # Apply and map statistics data <- by_layer(function(l, d) l$compute_statistic(d, layout), layers, data, "computing stat") @@ -79,6 +81,7 @@ ggplot_build.ggplot <- function(plot) { # Reset position scales, then re-train and map. This ensures that facets # have control over the range of a plot: is it generated from what is # displayed, or does it include the range of underlying data + data <- .ignore_data(data) layout$reset_scales() layout$train_position(data, scale_x(), scale_y()) layout$setup_panel_params() @@ -97,6 +100,7 @@ ggplot_build.ggplot <- function(plot) { # Only keep custom guides if there are no non-position scales plot$guides <- plot$guides$get_custom() } + data <- .expose_data(data) # Fill in defaults etc. data <- by_layer(function(l, d) l$compute_geom_2(d), layers, data, "setting up geom aesthetics") diff --git a/R/utilities.R b/R/utilities.R index 83ee801273..5888423cea 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -598,6 +598,69 @@ is_bang <- function(x) { is_call(x, "!", n = 1) } +# Puts all columns with 'AsIs' type in a '.ignore' column. + + + +#' Ignoring and exposing data +#' +#' The `.ignore_data()` function is used to hide `` columns during +#' scale interactions in `ggplot_build()`. The `.expose_data()` function is +#' used to restore hidden columns. +#' +#' @param data A list of ``s. +#' +#' @return A modified list of `s` +#' @export +#' @keywords internal +#' @name ignoring_data +#' +#' @examples +#' data <- list( +#' data.frame(x = 1:3, y = I(1:3)), +#' data.frame(w = I(1:3), z = 1:3) +#' ) +#' +#' ignored <- .ignore_data(data) +#' str(ignored) +#' +#' .expose_data(ignored) +.ignore_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_asis <- vapply(df, inherits, logical(1), what = "AsIs") + if (!any(is_asis)) { + return(df) + } + df <- unclass(df) + # We trust that 'df' is a valid data.frame with equal length columns etc, + # so we can use the more performant `new_data_frame()` + new_data_frame(c( + df[!is_asis], + list(.ignored = new_data_frame(df[is_asis])) + )) + }) +} + +# Restores all columns packed into the '.ignored' column. +#' @rdname ignoring_data +#' @export +.expose_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_ignored <- which(names(df) == ".ignored") + if (length(is_ignored) == 0) { + return(df) + } + df <- unclass(df) + new_data_frame(c(df[-is_ignored], df[[is_ignored[1]]])) + }) +} + is_triple_bang <- function(x) { if (!is_bang(x)) { return(FALSE) diff --git a/man/ignoring_data.Rd b/man/ignoring_data.Rd new file mode 100644 index 0000000000..4f1e0817d8 --- /dev/null +++ b/man/ignoring_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ignoring_data} +\alias{ignoring_data} +\alias{.ignore_data} +\alias{.expose_data} +\title{Ignoring and exposing data} +\usage{ +.ignore_data(data) + +.expose_data(data) +} +\arguments{ +\item{data}{A list of \verb{}s.} +} +\value{ +A modified list of \verb{s} +} +\description{ +The \code{.ignore_data()} function is used to hide \verb{} columns during +scale interactions in \code{ggplot_build()}. The \code{.expose_data()} function is +used to restore hidden columns. +} +\examples{ +data <- list( + data.frame(x = 1:3, y = I(1:3)), + data.frame(w = I(1:3), z = 1:3) +) + +ignored <- .ignore_data(data) +str(ignored) + +.expose_data(ignored) +} +\keyword{internal} diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 2a695d0117..9604303df9 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -177,3 +177,21 @@ test_that("resolution() gives correct answers", { # resolution has a tolerance expect_equal(resolution(c(1, 1 + 1000 * .Machine$double.eps, 2)), 1) }) + +test_that("expose/ignore_data() can round-trip a data.frame", { + + # Plain data.frame + df <- data_frame0(a = 1:3, b = 4:6, c = LETTERS[1:3], d = LETTERS[4:6]) + expect_equal(list(df), .ignore_data(df)) + expect_equal(list(df), .expose_data(df)) + + # data.frame with ignored columns + df <- data_frame0(a = 1:3, b = I(4:6), c = LETTERS[1:3], d = I(LETTERS[4:6])) + test <- .ignore_data(df)[[1]] + expect_equal(names(test), c("a", "c", ".ignored")) + expect_equal(names(test$.ignored), c("b", "d")) + + test <- .expose_data(test)[[1]] + expect_equal(test, df[, c("a", "c", "b", "d")]) + +}) From 70a4c0ec11b6eb4a6e67cd3ab5fd89df4ef260d7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 11:07:39 +0100 Subject: [PATCH 13/22] early exit for null device (#5567) --- R/utilities-checks.R | 15 ++++++++++----- man/check_device.Rd | 3 ++- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 418268a832..db5fee2353 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -89,7 +89,8 @@ check_inherits <- function(x, #' either `"blending"` or `"compositing"`. If `NULL` (default), support for #' all known blending or compositing operations is queried. #' @param maybe A logical of length 1 determining what the return value should -#' be in case the device capabilities cannot be assessed. +#' be in case the device capabilities cannot be assessed. When the current +#' device is the 'null device', `maybe` is returned. #' @param call The execution environment of a currently running function, e.g. #' [`caller_env()`][rlang::caller_env()]. The function will be mentioned in #' warnings and error messages as the source of the warning or error. See @@ -186,6 +187,14 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, check_bool(maybe, allow_na = TRUE) + # Grab device for checking + dev_cur <- grDevices::dev.cur() + dev_name <- names(dev_cur) + + if (dev_name == "null device") { + return(maybe) + } + action <- arg_match0(action, c("test", "warn", "abort")) action_fun <- switch( action, @@ -233,10 +242,6 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, return(FALSE) } - # Grab device for checking - dev_cur <- grDevices::dev.cur() - dev_name <- names(dev_cur) - if (dev_name == "RStudioGD") { # RStudio opens RStudioGD as the active graphics device, but the back-end # appears to be the *next* device. Temporarily set the next device as the diff --git a/man/check_device.Rd b/man/check_device.Rd index cc09a1de67..906d3ce6e9 100644 --- a/man/check_device.Rd +++ b/man/check_device.Rd @@ -33,7 +33,8 @@ either \code{"blending"} or \code{"compositing"}. If \code{NULL} (default), supp all known blending or compositing operations is queried.} \item{maybe}{A logical of length 1 determining what the return value should -be in case the device capabilities cannot be assessed.} +be in case the device capabilities cannot be assessed. When the current +device is the 'null device', \code{maybe} is returned.} \item{call}{The execution environment of a currently running function, e.g. \code{\link[rlang:stack]{caller_env()}}. The function will be mentioned in From dad8a4b9d3af9301868e7d3826d4f6641775f4f2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 11:37:55 +0100 Subject: [PATCH 14/22] Arbitrary positions for guides (#5488) * Add legends in all positions * Assemble separate guide boxes * Add position argument to guides * reoxygenate * adapt tests * deal with old R units * rename manual position to "inside" * resolve spacing once * omit 'inside' option in justification * Move more responsibility to `Guides$draw()` * Propagate "manual" -> "inside" rename * Fallback for inside position * Rearrange methods into logical order * remove vestigial stuff * Separate numeric inside positioning from `legend.position` argument * Implement plot-wise justification (#4020) * Partially revert bd917cf * Add extra justification theme settings * Document `legend.justification.{position}` * Apply justification * Prevent FP warnings by partial matching * Switch to new inside position * Add test for justification per position * Fix subsetting bug * always add gtable rows/cols * adjust table dimension expectations * adapt test * Don't calculate key sizes twice * Use `calc_element()` * Use conventional indexing * prevent partial matching * Move justification responsiblity to `Guides$package_box()` * Fix bug * incorporate guide_custom * incorporate guide_custom --- R/guide-bins.R | 5 + R/guide-colorbar.R | 5 + R/guide-custom.R | 2 +- R/guide-legend.R | 7 + R/guides-.R | 208 +++++++++++++----- R/plot-build.R | 178 ++++++++------- R/theme-elements.R | 27 ++- R/theme.R | 26 ++- man/guide_bins.Rd | 4 + man/guide_colourbar.Rd | 5 + man/guide_coloursteps.Rd | 2 + man/guide_custom.Rd | 2 +- man/guide_legend.Rd | 4 + man/theme.Rd | 20 +- ...egends-at-all-sides-with-justification.svg | 157 +++++++++++++ tests/testthat/test-facet-strips.R | 10 +- tests/testthat/test-guides.R | 26 +-- tests/testthat/test-theme.R | 32 +++ 18 files changed, 554 insertions(+), 166 deletions(-) create mode 100644 tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg diff --git a/R/guide-bins.R b/R/guide-bins.R index 77ea847b53..b2b0bb9d56 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -100,6 +100,7 @@ guide_bins <- function( ticks.length = unit(0.2, "npc"), # general + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -121,6 +122,9 @@ guide_bins <- function( if (!is.null(title.position)) { title.position <- arg_match0(title.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } if (!is.null(direction)) { direction <- arg_match0(direction, c("horizontal", "vertical")) } @@ -169,6 +173,7 @@ guide_bins <- function( ticks_length = ticks.length, # general + position = position, direction = direction, override.aes = rename_aes(override.aes), reverse = reverse, diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 6e2206a26e..374f8ac92e 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -151,6 +151,7 @@ guide_colourbar <- function( draw.llim = TRUE, # general + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -171,6 +172,9 @@ guide_colourbar <- function( if (!is.null(title.position)) { title.position <- arg_match0(title.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } if (!is.null(direction)) { direction <- arg_match0(direction, c("horizontal", "vertical")) } @@ -240,6 +244,7 @@ guide_colourbar <- function( draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)), # general + position = position, direction = direction, reverse = reverse, order = order, diff --git a/R/guide-custom.R b/R/guide-custom.R index 3ea4fc3ffe..bca9e0214d 100644 --- a/R/guide-custom.R +++ b/R/guide-custom.R @@ -43,7 +43,7 @@ guide_custom <- function( grob, width = grobWidth(grob), height = grobHeight(grob), title = NULL, title.position = "top", margin = NULL, - position = waiver(), order = 0 + position = NULL, order = 0 ) { check_object(grob, is.grob, "a {.cls grob} object") check_object(width, is.unit, "a {.cls unit} object") diff --git a/R/guide-legend.R b/R/guide-legend.R index 056ca8f68b..910ef12cc3 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -46,6 +46,8 @@ #' object specifying the distance between key-label pairs in the horizontal #' direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both #' (`key.spacing`). +#' @param position A character string indicating where the legend should be +#' placed relative to the plot panels. #' @param direction A character string indicating the direction of the guide. #' One of "horizontal" or "vertical." #' @param default.unit A character string indicating [grid::unit()] @@ -152,6 +154,7 @@ guide_legend <- function( key.spacing.y = NULL, # General + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -187,6 +190,9 @@ guide_legend <- function( if (!is.null(label.position)) { label.position <- arg_match0(label.position, .trbl) } + if (!is.null(position)) { + position <- arg_match0(position, c(.trbl, "inside")) + } new_guide( # Title @@ -217,6 +223,7 @@ guide_legend <- function( byrow = byrow, reverse = reverse, order = order, + position = position, # Fixed parameters available_aes = "any", diff --git a/R/guides-.R b/R/guides-.R index ee1ddb2477..c44fc06907 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -262,8 +262,8 @@ Guides <- ggproto( ## Building ------------------------------------------------------------------ - # The `Guides$build()` method is called in ggplotGrob (plot-build.R) and makes - # the guide box for *non-position* scales. + # The `Guides$build()` method is called in ggplot_build (plot-build.R) and + # collects all information needed from the plot. # Note that position scales are handled in `Coord`s, which have their own # procedures to do equivalent steps. # @@ -283,12 +283,7 @@ Guides <- ggproto( # 3. Guides$process_layers() # process layer information and generate geom info. # - # 4. Guides$draw() - # generate guide grob from each guide object - # one guide grob for one guide object - # - # 5. Guides$assemble() - # arrange all guide grobs + # The resulting guide is then drawn in ggplot_gtable build = function(self, scales, layers, labels, layer_data) { @@ -476,49 +471,105 @@ Guides <- ggproto( invisible() }, - # Loop over every guide, let them draw their grobs - draw = function(self, theme, position, direction) { - Map( - function(guide, params) guide$draw(theme, position, direction, params), - guide = self$guides, - params = self$params - ) - }, - + # The `Guides$assemble()` method is called in ggplot_gtable (plot-build.R) and + # applies the styling from the theme to render each guide and package them + # into guide boxes. + # + # The procedure is as follows + # + # 1. Guides$draw() + # for every guide object, draw one grob, + # then group the grobs in a list per position + # + # 2. Guides$package_box() + # for every position, collect all individual guides and arrange them + # into a guide box which will be inserted into the main gtable # Combining multiple guides in a guide box - assemble = function(self, theme, position) { + assemble = function(self, theme) { if (length(self$guides) < 1) { return(zeroGrob()) } - position <- legend_position(position) - if (position == "none") { + default_position <- theme$legend.position %||% "right" + if (length(default_position) == 2) { + default_position <- "inside" + } + if (default_position == "none") { return(zeroGrob()) } - default_direction <- if (position == "inside") "vertical" else position - theme$legend.key.width <- theme$legend.key.width %||% theme$legend.key.size - theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size - theme$legend.box <- theme$legend.box %||% default_direction - theme$legend.direction <- theme$legend.direction %||% default_direction - theme$legend.box.just <- theme$legend.box.just %||% switch( - position, - inside = c("center", "center"), - vertical = c("left", "top"), - horizontal = c("center", "top") - ) + # Populate key sizes + theme$legend.key.width <- calc_element("legend.key.width", theme) + theme$legend.key.height <- calc_element("legend.key.height", theme) - grobs <- self$draw(theme, position, theme$legend.direction) + grobs <- self$draw(theme, default_position, theme$legend.direction) if (length(grobs) < 1) { return(zeroGrob()) } grobs <- grobs[order(names(grobs))] # Set spacing - theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines") - theme$legend.spacing.y <- theme$legend.spacing.y %||% theme$legend.spacing - theme$legend.spacing.x <- theme$legend.spacing.x %||% theme$legend.spacing + theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines") + theme$legend.spacing.y <- calc_element("legend.spacing.y", theme) + theme$legend.spacing.x <- calc_element("legend.spacing.x", theme) + + Map( + grobs = grobs, + position = names(grobs), + self$package_box, + MoreArgs = list(theme = theme) + ) + }, + + # Render the guides into grobs + draw = function(self, theme, + default_position = "right", + direction = NULL, + params = self$params, + guides = self$guides) { + positions <- vapply( + params, + function(p) p$position[1] %||% default_position, + character(1) + ) + positions <- factor(positions, levels = c(.trbl, "inside")) + + directions <- rep(direction %||% "vertical", length(positions)) + if (is.null(direction)) { + directions[positions %in% c("top", "bottom")] <- "horizontal" + } + + grobs <- vector("list", length(guides)) + for (i in seq_along(grobs)) { + grobs[[i]] <- guides[[i]]$draw( + theme = theme, position = as.character(positions[i]), + direction = directions[i], params = params[[i]] + ) + } + split(grobs, positions) + }, + + package_box = function(grobs, position, theme) { + + if (is.zero(grobs) || length(grobs) == 0) { + return(zeroGrob()) + } + + # Determine default direction + direction <- switch( + position, + inside = , left = , right = "vertical", + top = , bottom = "horizontal" + ) + + # Populate missing theme arguments + theme$legend.box <- theme$legend.box %||% direction + theme$legend.box.just <- theme$legend.box.just %||% switch( + direction, + vertical = c("left", "top"), + horizontal = c("center", "top") + ) # Measure guides widths <- lapply(grobs, function(g) sum(g$widths)) @@ -526,54 +577,95 @@ Guides <- ggproto( heights <- lapply(grobs, function(g) sum(g$heights)) heights <- inject(unit.c(!!!heights)) + # Global justification of the complete legend box + global_just <- paste0("legend.justification.", position) + global_just <- valid.just(calc_element(global_just, theme)) + + if (position == "inside") { + # The position of inside legends are set by their justification + inside_position <- theme$legend.position.inside %||% global_just + global_xjust <- inside_position[1] + global_yjust <- inside_position[2] + global_margin <- margin() + } else { + global_xjust <- global_just[1] + global_yjust <- global_just[2] + # Legends to the side of the plot need a margin for justification + # relative to the plot panel + global_margin <- margin( + t = 1 - global_yjust, b = global_yjust, + r = 1 - global_xjust, l = global_xjust, + unit = "null" + ) + } + # Set the justification of each legend within the legend box # First value is xjust, second value is yjust - just <- valid.just(theme$legend.box.just) - xjust <- just[1] - yjust <- just[2] + box_just <- valid.just(theme$legend.box.just) + box_xjust <- box_just[1] + box_yjust <- box_just[2] # setting that is different for vertical and horizontal guide-boxes. if (identical(theme$legend.box, "horizontal")) { - # Set justification for each legend + # Set justification for each legend within the box for (i in seq_along(grobs)) { grobs[[i]] <- editGrob( grobs[[i]], - vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust), + vp = viewport(x = box_xjust, y = box_yjust, just = box_just, height = heightDetails(grobs[[i]])) ) } + spacing <- theme$legend.spacing.x + + # Set global justification + vp <- viewport( + x = global_xjust, y = global_yjust, just = global_just, + height = max(heights), + width = sum(widths, spacing * (length(grobs) - 1L)) + ) - guides <- gtable_row(name = "guides", - grobs = grobs, - widths = widths, height = max(heights)) + # Initialise gtable as legends in a row + guides <- gtable_row( + name = "guides", grobs = grobs, + widths = widths, height = max(heights), + vp = vp + ) - # add space between the guide-boxes - guides <- gtable_add_col_space(guides, theme$legend.spacing.x) + # Add space between the guide-boxes + guides <- gtable_add_col_space(guides, spacing) } else { # theme$legend.box == "vertical" - # Set justification for each legend + # Set justification for each legend within the box for (i in seq_along(grobs)) { grobs[[i]] <- editGrob( grobs[[i]], - vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust), + vp = viewport(x = box_xjust, y = box_yjust, just = box_just, width = widthDetails(grobs[[i]])) ) } + spacing <- theme$legend.spacing.y + + # Set global justification + vp <- viewport( + x = global_xjust, y = global_yjust, just = global_just, + height = sum(heights, spacing * (length(grobs) - 1L)), + width = max(widths) + ) - guides <- gtable_col(name = "guides", - grobs = grobs, - width = max(widths), heights = heights) + # Initialise gtable as legends in a column + guides <- gtable_col( + name = "guides", grobs = grobs, + width = max(widths), heights = heights, + vp = vp + ) - # add space between the guide-boxes - guides <- gtable_add_row_space(guides, theme$legend.spacing.y) + # Add space between the guide-boxes + guides <- gtable_add_row_space(guides, spacing) } # Add margins around the guide-boxes. margin <- theme$legend.box.margin %||% margin() - guides <- gtable_add_cols(guides, margin[4], pos = 0) - guides <- gtable_add_cols(guides, margin[2], pos = ncol(guides)) - guides <- gtable_add_rows(guides, margin[1], pos = 0) - guides <- gtable_add_rows(guides, margin[3], pos = nrow(guides)) + guides <- gtable_add_padding(guides, margin) # Add legend box background background <- element_grob(theme$legend.box.background %||% element_blank()) @@ -584,6 +676,10 @@ Guides <- ggproto( z = -Inf, clip = "off", name = "legend.box.background" ) + + # Set global margin + guides <- gtable_add_padding(guides, global_margin) + guides$name <- "guide-box" guides }, diff --git a/R/plot-build.R b/R/plot-build.R index cf3ff3fdcd..2a46b31514 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -182,91 +182,8 @@ ggplot_gtable.ggplot_built <- function(data) { plot_table <- layout$render(geom_grobs, data, theme, plot$labels) # Legends - position <- theme$legend.position %||% "right" - if (length(position) == 2) { - position <- "manual" - } - - legend_box <- plot$guides$assemble(theme, position) - - if (is.zero(legend_box)) { - position <- "none" - } else { - # these are a bad hack, since it modifies the contents of viewpoint directly... - legend_width <- gtable_width(legend_box) - legend_height <- gtable_height(legend_box) - - # Set the justification of the legend box - # First value is xjust, second value is yjust - just <- valid.just(theme$legend.justification) - xjust <- just[1] - yjust <- just[2] - - if (position == "manual") { - xpos <- theme$legend.position[1] - ypos <- theme$legend.position[2] - - # x and y are specified via theme$legend.position (i.e., coords) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xpos, - y = ypos, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - } else { - # x and y are adjusted using justification of legend box (i.e., theme$legend.justification) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xjust, - y = yjust, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - legend_box <- gtable_add_rows(legend_box, unit(yjust, 'null')) - legend_box <- gtable_add_rows(legend_box, unit(1 - yjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(xjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(1 - xjust, 'null')) - } - } - - panel_dim <- find_panel(plot_table) - # for align-to-device, use this: - # panel_dim <- summarise(plot_table$layout, t = min(t), r = max(r), b = max(b), l = min(l)) - - theme$legend.box.spacing <- theme$legend.box.spacing %||% unit(0.2, 'cm') - if (position == "left") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "guide-box") - } else if (position == "right") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "guide-box") - } else if (position == "bottom") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "top") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "manual") { - # should guide box expand whole region or region without margin? - plot_table <- gtable_add_grob(plot_table, legend_box, - t = panel_dim$t, b = panel_dim$b, l = panel_dim$l, r = panel_dim$r, - clip = "off", name = "guide-box") - } + legend_box <- plot$guides$assemble(theme) + plot_table <- table_add_legends(plot_table, legend_box, theme) # Title title <- element_render( @@ -502,3 +419,94 @@ table_add_tag <- function(table, label, theme) { t = place$t, l = place$l, b = place$b, r = place$r ) } + +# Add the legends to the gtable +table_add_legends <- function(table, legends, theme) { + + if (is.zero(legends)) { + legends <- rep(list(zeroGrob()), 5) + names(legends) <- c(.trbl, "inside") + } + + # Extract sizes + widths <- heights <- set_names( + rep(list(unit(0, "cm")), length(legends)), + names(legends) + ) + + empty <- vapply(legends, is.zero, logical(1)) + widths[!empty] <- lapply(legends[!empty], gtable_width) + heights[!empty] <- lapply(legends[!empty], gtable_height) + spacing <- theme$legend.box.spacing %||% unit(0.2, "cm") + + # If legend is missing, set spacing to zero for that legend + zero <- unit(0, "pt") + spacing <- lapply(empty, function(is_empty) if (is_empty) zero else spacing) + + location <- switch( + theme$legend.location %||% "panel", + "plot" = plot_extent, + find_panel + ) + + place <- location(table) + + # Add right legend + table <- gtable_add_cols(table, spacing$right, pos = -1) + table <- gtable_add_cols(table, widths$right, pos = -1) + table <- gtable_add_grob( + table, legends$right, clip = "off", + t = place$t, b = place$b, l = -1, r = -1, + name = "guide-box-right" + ) + + # Add left legend + table <- gtable_add_cols(table, spacing$left, pos = 0) + table <- gtable_add_cols(table, widths$left, pos = 0) + table <- gtable_add_grob( + table, legends$left, clip = "off", + t = place$t, b = place$b, l = 1, r = 1, + name = "guide-box-left" + ) + + place <- location(table) + + # Add bottom legend + table <- gtable_add_rows(table, spacing$bottom, pos = -1) + table <- gtable_add_rows(table, heights$bottom, pos = -1) + table <- gtable_add_grob( + table, legends$bottom, clip = "off", + t = -1, b = -1, l = place$l, r = place$r, + name = "guide-box-bottom" + ) + + # Add top legend + table <- gtable_add_rows(table, spacing$top, pos = 0) + table <- gtable_add_rows(table, heights$top, pos = 0) + table <- gtable_add_grob( + table, legends$top, clip = "off", + t = 1, b = 1, l = place$l, r = place$r, + name = "guide-box-top" + ) + + # Add manual legend + place <- find_panel(table) + table <- gtable_add_grob( + table, legends$inside, clip = "off", + t = place$t, b = place$b, l = place$l, r = place$r, + name = "guide-box-inside" + ) + + table +} + +plot_extent <- function(table) { + layout <- table$layout + data_frame0( + t = min(layout[["t"]]), + r = max(layout[["r"]]), + b = max(layout[["b"]]), + l = min(layout[["l"]]), + .size = 1L + ) +} diff --git a/R/theme-elements.R b/R/theme-elements.R index d671ec2900..448aa4763a 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -502,9 +502,34 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key.width = el_def(c("unit", "rel"), "legend.key.size"), legend.text = el_def("element_text", "text"), legend.title = el_def("element_text", "title"), - legend.position = el_def(c("character", "numeric", "integer")), + legend.position = el_def("character"), + legend.position.inside = el_def(c("numeric", "integer")), legend.direction = el_def("character"), + legend.justification = el_def(c("character", "numeric", "integer")), + legend.justification.top = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.bottom = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.left = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.right = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.inside = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + + legend.location = el_def("character"), + legend.box = el_def("character"), legend.box.just = el_def("character"), legend.box.margin = el_def("margin"), diff --git a/R/theme.R b/R/theme.R index dda2dcd8c8..6def5d7ab5 100644 --- a/R/theme.R +++ b/R/theme.R @@ -78,13 +78,20 @@ #' `text`) #' @param legend.title title of legend ([element_text()]; inherits from #' `title`) -#' @param legend.position the position of legends ("none", "left", "right", -#' "bottom", "top", or two-element numeric vector) +#' @param legend.position the default position of legends ("none", "left", +#' "right", "bottom", "top", "inside") +#' @param legend.position.inside A numeric vector of length two setting the +#' placement of legends that have the `"inside"` position. #' @param legend.direction layout of items in legends ("horizontal" or #' "vertical") #' @param legend.justification anchor point for positioning legend inside plot #' ("center" or two-element numeric vector) or the justification according to #' the plot area when positioned outside the plot +#' @param legend.justification.top,legend.justification.bottom,legend.justification.left,legend.justification.right,legend.justification.inside +#' Same as `legend.justification` but specified per `legend.position` option. +#' @param legend.location Relative placement of legends outside the plot as a +#' string. Can be `"panel"` (default) to align legends to the panels or +#' `"plot"` to align legends to the plot as a whole. #' @param legend.box arrangement of multiple legends ("horizontal" or #' "vertical") #' @param legend.box.just justification of each legend within the overall @@ -345,8 +352,15 @@ theme <- function(..., legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -455,6 +469,14 @@ theme <- function(..., } elements$legend.text.align <- NULL } + if (is.numeric(elements[["legend.position"]])) { + deprecate_soft0( + "3.5.0", I("A numeric `legend.position` argument in `theme()`"), + "theme(legend.position.inside)" + ) + elements$legend.position.inside <- elements$legend.position + elements$legend.position <- "inside" + } # If complete theme set all non-blank elements to inherit from blanks if (complete) { diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 6eeada9598..811037d474 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -23,6 +23,7 @@ guide_bins( axis.arrow = NULL, ticks = NULL, ticks.length = unit(0.2, "npc"), + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -98,6 +99,9 @@ re-used as \code{ticks} argument (without arrow).} \item{ticks.length}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the length of tick marks between the keys.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 7813c12b1c..8273ec4326 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -30,6 +30,7 @@ guide_colourbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -63,6 +64,7 @@ guide_colorbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -159,6 +161,9 @@ be visible.} \item{draw.llim}{A logical specifying if the lower limit tick marks should be visible.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index e97230b6f4..d77895415e 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -96,6 +96,8 @@ label text. The default for standard text is 0 (left-aligned) and 1 (right-aligned) for expressions.} \item{\code{label.vjust}}{A numeric specifying vertical justification of the label text.} + \item{\code{position}}{A character string indicating where the legend should be +placed relative to the plot panels.} \item{\code{order}}{positive integer less than 99 that specifies the order of this guide among multiple guides. This controls the order in which multiple guides are displayed, not the contents of the guide itself. diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd index 3893dbc2c9..ad8a77b80b 100644 --- a/man/guide_custom.Rd +++ b/man/guide_custom.Rd @@ -11,7 +11,7 @@ guide_custom( title = NULL, title.position = "top", margin = NULL, - position = waiver(), + position = NULL, order = 0 ) } diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index 224de5587a..75e965adfc 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -20,6 +20,7 @@ guide_legend( key.spacing = NULL, key.spacing.x = NULL, key.spacing.y = NULL, + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -82,6 +83,9 @@ object specifying the distance between key-label pairs in the horizontal direction (\code{key.spacing.x}), vertical direction (\code{key.spacing.y}) or both (\code{key.spacing}).} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/theme.Rd b/man/theme.Rd index 4c91c5fe85..f0f7b179e1 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -69,8 +69,15 @@ theme( legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -187,8 +194,11 @@ inherits from \code{rect})} \item{legend.title}{title of legend (\code{\link[=element_text]{element_text()}}; inherits from \code{title})} -\item{legend.position}{the position of legends ("none", "left", "right", -"bottom", "top", or two-element numeric vector)} +\item{legend.position}{the default position of legends ("none", "left", +"right", "bottom", "top", "inside")} + +\item{legend.position.inside}{A numeric vector of length two setting the +placement of legends that have the \code{"inside"} position.} \item{legend.direction}{layout of items in legends ("horizontal" or "vertical")} @@ -197,6 +207,12 @@ inherits from \code{rect})} ("center" or two-element numeric vector) or the justification according to the plot area when positioned outside the plot} +\item{legend.justification.top, legend.justification.bottom, legend.justification.left, legend.justification.right, legend.justification.inside}{Same as \code{legend.justification} but specified per \code{legend.position} option.} + +\item{legend.location}{Relative placement of legends outside the plot as a +string. Can be \code{"panel"} (default) to align legends to the panels or +\code{"plot"} to align legends to the plot as a whole.} + \item{legend.box}{arrangement of multiple legends ("horizontal" or "vertical")} diff --git a/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg new file mode 100644 index 0000000000..9847f9f0c9 --- /dev/null +++ b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + + + +100 +200 +300 +400 +disp +mpg + +wt + + + + + + + + +2 +3 +4 +5 + +drat + + + + + + + + +3.0 +3.5 +4.0 +4.5 + +hp + + + + + + + + + + + +100 +150 +200 +250 +300 + +factor(cyl) + + + + + + +4 +6 +8 + +factor(gear) + + + + + + +3 +4 +5 +legends at all sides with justification + + diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R index a56f5644cb..1ee8792e99 100644 --- a/tests/testthat/test-facet-strips.R +++ b/tests/testthat/test-facet-strips.R @@ -154,19 +154,19 @@ test_that("padding is only added if axis is present", { strip.switch.pad.grid = unit(10, "mm") ) pg <- ggplotGrob(p) - expect_equal(length(pg$heights), 13) + expect_equal(length(pg$heights), 17) pg <- ggplotGrob(p + scale_x_continuous(position = "top")) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") # Also add padding with negative ticks and no text (#5251) pg <- ggplotGrob( p + scale_x_continuous(labels = NULL, position = "top") + theme(axis.ticks.length.x.top = unit(-2, "mm")) ) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") }) test_that("y strip labels are rotated when strips are switched", { diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 58d5d04124..69b7bb558c 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -51,22 +51,21 @@ test_that("Colorbar respects show.legend in layer", { df <- data_frame(x = 1:3, y = 1) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = FALSE) - expect_false("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 0L) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = TRUE) - expect_true("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 1L) }) test_that("show.legend handles named vectors", { n_legends <- function(p) { g <- ggplotGrob(p) - gb <- which(g$layout$name == "guide-box") - if (length(gb) > 0) { - n <- length(g$grobs[[gb]]) - 1 - } else { - n <- 0 - } - n + gb <- grep("guide-box", g$layout$name) + n <- vapply(g$grobs[gb], function(x) { + if (is.zero(x)) return(0) + length(x$grobs) - 1 + }, numeric(1)) + sum(n) } df <- data_frame(x = 1:3, y = 20:22) @@ -749,18 +748,19 @@ test_that("guides are positioned correctly", { expect_doppelganger("padding in legend box", p2) + p2 <- p2 + theme(legend.position = "inside") # Placement of legend inside expect_doppelganger("legend inside plot, centered", - p2 + theme(legend.position = c(.5, .5)) + p2 + theme(legend.position.inside = c(.5, .5)) ) expect_doppelganger("legend inside plot, bottom left", - p2 + theme(legend.justification = c(0,0), legend.position = c(0,0)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(0,0)) ) expect_doppelganger("legend inside plot, top right", - p2 + theme(legend.justification = c(1,1), legend.position = c(1,1)) + p2 + theme(legend.justification = c(1,1), legend.position.inside = c(1,1)) ) expect_doppelganger("legend inside plot, bottom left of legend at center", - p2 + theme(legend.justification = c(0,0), legend.position = c(.5,.5)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(.5,.5)) ) }) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 53feb08832..af6a4b670a 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -743,6 +743,38 @@ test_that("plot titles and caption can be aligned to entire plot", { }) +test_that("Legends can on all sides of the plot with custom justification", { + + plot <- ggplot(mtcars) + + aes( + disp, mpg, + colour = hp, + fill = factor(gear), + shape = factor(cyl), + size = drat, + alpha = wt + ) + + geom_point() + + guides( + shape = guide_legend(position = "top"), + colour = guide_colourbar(position = "bottom"), + size = guide_legend(position = "left"), + alpha = guide_legend(position = "right"), + fill = guide_legend(position = "inside", override.aes = list(shape = 21)) + ) + + theme_test() + + theme( + legend.justification.top = "left", + legend.justification.bottom = c(1, 0), + legend.justification.left = c(0, 1), + legend.justification.right = "bottom", + legend.justification.inside = c(0.75, 0.75), + legend.location = "plot" + ) + + expect_doppelganger("legends at all sides with justification", plot) +}) + test_that("Strips can render custom elements", { element_test <- function(...) { el <- element_text(...) From 5edfbbe22bef984ce5252f7c0672d6ff3cd0f877 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 12:52:53 +0100 Subject: [PATCH 15/22] Change minor breaks interface (#5569) * reimplement #3591 * Do not censor major breaks * view scales censor major breaks after calculation of minor breaks * guides censor breaks * tests expect non-censored breaks * add news bullet * adjust docs * fix typo --- NEWS.md | 6 ++++ R/guide-.R | 3 +- R/guide-bins.R | 1 + R/guide-colorsteps.R | 2 ++ R/scale-.R | 37 +++++++++++++++------- R/scale-view.R | 4 ++- man/continuous_scale.Rd | 4 ++- man/scale_continuous.Rd | 4 ++- man/scale_gradient.Rd | 4 ++- man/scale_size.Rd | 4 ++- tests/testthat/test-scales-breaks-labels.R | 6 ++-- 11 files changed, 54 insertions(+), 21 deletions(-) diff --git a/NEWS.md b/NEWS.md index a529b46d31..476076f956 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # ggplot2 (development version) +* The `minor_breaks` function argument in scales can now take a function with + two arguments: the scale's limits and the scale's major breaks (#3583). + +* (internal) The `ScaleContinuous$get_breaks()` method no longer censors + the computed breaks. + * Plot scales now ignore `AsIs` objects constructed with `I(x)`, instead of invoking the identity scale. This allows these columns to co-exist with other layers that need a non-identity scale for the same aesthetic. Also, it makes diff --git a/R/guide-.R b/R/guide-.R index cdb750ce56..85fb5ee942 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -224,7 +224,8 @@ Guide <- ggproto( key$.label <- labels if (is.numeric(breaks)) { - vec_slice(key, is.finite(breaks)) + range <- scale$continuous_range %||% scale$get_limits() + key <- vec_slice(key, is.finite(oob_censor_any(breaks, range))) } else { key } diff --git a/R/guide-bins.R b/R/guide-bins.R index b2b0bb9d56..54676378bb 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -267,6 +267,7 @@ GuideBins <- ggproto( } key$.label <- labels + key <- vec_slice(key, !is.na(oob_censor_any(key$.value))) return(key) }, diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index c5315e6da6..7206a4c19e 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -181,6 +181,8 @@ GuideColoursteps <- ggproto( params$key$.value <- rescale(params$key$.value, from = limits) params$decor$min <- rescale(params$decor$min, from = limits) params$decor$max <- rescale(params$decor$max, from = limits) + params$key <- + vec_slice(params$key, !is.na(oob_censor_any(params$key$.value))) params }, diff --git a/R/scale-.R b/R/scale-.R index f559dbb37d..d4a4eaa857 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -26,7 +26,9 @@ #' each major break) #' - A numeric vector of positions #' - A function that given the limits returns a vector of minor breaks. Also -#' accepts rlang [lambda][rlang::as_function()] function notation. +#' accepts rlang [lambda][rlang::as_function()] function notation. When +#' the function has two arguments, it will be given the limits and major +#' breaks. #' @param n.breaks An integer guiding the number of major breaks. The algorithm #' may choose a slightly different number to ensure nice break labels. Will #' only have an effect if `breaks = waiver()`. Use `NULL` to use the default @@ -714,11 +716,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } # Breaks in data space need to be converted back to transformed space - breaks <- self$trans$transform(breaks) - # Any breaks outside the dimensions are flagged as missing - breaks <- censor(breaks, self$trans$transform(limits), only.finite = FALSE) - - breaks + self$trans$transform(breaks) }, get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { @@ -736,6 +734,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, call = self$call ) } + # major breaks are not censored, however; + # some transforms assume finite major breaks + b <- b[is.finite(b)] if (is.waive(self$minor_breaks)) { if (is.null(b)) { @@ -744,8 +745,18 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, breaks <- self$trans$minor_breaks(b, limits, n) } } else if (is.function(self$minor_breaks)) { - # Find breaks in data space, and convert to numeric - breaks <- self$minor_breaks(self$trans$inverse(limits)) + # Using `fetch_ggproto` here to avoid auto-wrapping the user-supplied + # breaks function as a ggproto method. + break_fun <- fetch_ggproto(self, "minor_breaks") + arg_names <- fn_fmls_names(break_fun) + + # Find breaks in data space + if (length(arg_names) == 1L) { + breaks <- break_fun(self$trans$inverse(limits)) + } else { + breaks <- break_fun(self$trans$inverse(limits), self$trans$inverse(b)) + } + # Convert breaks to numeric breaks <- self$trans$transform(breaks) } else { breaks <- self$trans$transform(self$minor_breaks) @@ -819,14 +830,16 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # labels labels <- self$get_labels(major) - # drop oob breaks/labels by testing major == NA - if (!is.null(labels)) labels <- labels[!is.na(major)] - if (!is.null(major)) major <- major[!is.na(major)] - # minor breaks minor <- self$get_breaks_minor(b = major, limits = range) if (!is.null(minor)) minor <- minor[!is.na(minor)] + major <- oob_censor_any(major, range) + + # drop oob breaks/labels by testing major == NA + if (!is.null(labels)) labels <- labels[!is.na(major)] + if (!is.null(major)) major <- major[!is.na(major)] + # rescale breaks [0, 1], which are used by coord/guide major_n <- rescale(major, from = range) minor_n <- rescale(minor, from = range) diff --git a/R/scale-view.R b/R/scale-view.R index 34af3181d8..1402a3ffee 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -21,10 +21,12 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), continuous_scale_sorted <- sort(continuous_range) breaks <- scale$get_breaks(continuous_scale_sorted) minor_breaks <- scale$get_breaks_minor(b = breaks, limits = continuous_scale_sorted) + breaks <- censor(breaks, continuous_scale_sorted, only.finite = FALSE) } else { breaks <- scale$get_breaks(limits) minor_breaks <- scale$get_breaks_minor(b = breaks, limits = limits) } + minor_breaks <- censor(minor_breaks, continuous_range, only.finite = FALSE) ggproto(NULL, ViewScale, scale = scale, @@ -76,7 +78,7 @@ view_scale_secondary <- function(scale, limits = scale$get_limits(), aesthetics = scale$aesthetics, name = scale$sec_name(), make_title = function(self, title) self$scale$make_sec_title(title), - + continuous_range = sort(continuous_range), dimension = function(self) self$break_info$range, get_limits = function(self) self$break_info$range, get_breaks = function(self) self$break_info$major_source, diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 407916b251..6bdc511f13 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -58,7 +58,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{n.breaks}{An integer guiding the number of major breaks. The algorithm diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index ec91afc919..da226139d7 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -79,7 +79,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{n.breaks}{An integer guiding the number of major breaks. The algorithm diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index cea9e781f9..379476681b 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -114,7 +114,9 @@ Also accepts rlang \link[rlang:as_function]{lambda} function notation. each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{\code{n.breaks}}{An integer guiding the number of major breaks. The algorithm may choose a slightly different number to ensure nice break labels. Will diff --git a/man/scale_size.Rd b/man/scale_size.Rd index 408493113f..d8b92414c7 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -131,7 +131,9 @@ breaks are given explicitly.} each major break) \item A numeric vector of positions \item A function that given the limits returns a vector of minor breaks. Also -accepts rlang \link[rlang:as_function]{lambda} function notation. +accepts rlang \link[rlang:as_function]{lambda} function notation. When +the function has two arguments, it will be given the limits and major +breaks. }} \item{\code{oob}}{One of: \itemize{ diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index 344d823d58..a83ed63498 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -1,7 +1,7 @@ test_that("labels match breaks, even when outside limits", { sc <- scale_y_continuous(breaks = 1:4, labels = 1:4, limits = c(1, 3)) - expect_equal(sc$get_breaks(), c(1:3, NA)) + expect_equal(sc$get_breaks(), 1:4) expect_equal(sc$get_labels(), 1:4) expect_equal(sc$get_breaks_minor(), c(1, 1.5, 2, 2.5, 3)) }) @@ -231,7 +231,7 @@ test_that("breaks can be specified by names of labels", { test_that("only finite or NA values for breaks for transformed scales (#871)", { sc <- scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", breaks = seq(0, 1, 0.2)) - breaks <- sc$get_breaks() + breaks <- sc$break_info()$major_source expect_true(all(is.finite(breaks) | is.na(breaks))) }) @@ -257,7 +257,7 @@ test_that("equal length breaks and labels can be passed to ViewScales with limit limits = c(10, 30) ) - expect_identical(test_scale$get_breaks(), c(NA, 20, NA)) + expect_identical(test_scale$get_breaks(), c(0, 20, 40)) expect_identical(test_scale$get_labels(), c(c("0", "20", "40"))) test_view_scale <- view_scale_primary(test_scale) From e51ca467eaec2268e298e14068af1f11ee8a484e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 8 Dec 2023 13:23:46 +0100 Subject: [PATCH 16/22] Size of text/label keys (#5562) * improve text label * improve label labels * add news bullet --- NEWS.md | 2 ++ R/legend-draw.R | 64 ++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 55 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index 476076f956..0b05e50440 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* `draw_key_label()` now better reflects the appearance of labels. + * The `minor_breaks` function argument in scales can now take a function with two arguments: the scale's limits and the scale's major breaks (#3583). diff --git a/R/legend-draw.R b/R/legend-draw.R index e039e97ac3..8ee116f65c 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -236,26 +236,68 @@ draw_key_smooth <- function(data, params, size) { #' @export #' @rdname draw_key draw_key_text <- function(data, params, size) { - if(is.null(data$label)) data$label <- "a" - - textGrob(data$label, 0.5, 0.5, - rot = data$angle %||% 0, + data$label <- data$label %||% "a" + just <- rotate_just(data$angle, data$hjust, data$vjust) + grob <- titleGrob( + data$label, + x = unit(just$hjust, "npc"), y = unit(just$vjust, "npc"), + angle = data$angle, + hjust = data$hjust, + vjust = data$vjust, gp = gpar( col = alpha(data$colour %||% data$fill %||% "black", data$alpha), - fontfamily = data$family %||% "", - fontface = data$fontface %||% 1, - fontsize = (data$size %||% 3.88) * .pt - ) + fontfamily = data$family %||% "", + fontface = data$fontface %||% 1, + fontsize = (data$size %||% 3.88) * .pt + ), + margin = margin(0.1, 0.1, 0.1, 0.1, unit = "lines"), + margin_x = TRUE, margin_y = TRUE ) + attr(grob, "width") <- convertWidth(grobWidth(grob), "cm", valueOnly = TRUE) + attr(grob, "height") <- convertHeight(grobHeight(grob), "cm", valueOnly = TRUE) + grob } #' @export #' @rdname draw_key draw_key_label <- function(data, params, size) { - grobTree( - draw_key_rect(data, list()), - draw_key_text(data, list()) + data$label <- data$label %||% "a" + just <- rotate_just(data$angle, data$hjust, data$vjust) + padding <- rep(params$label.padding, length.out = 4) + descent <- font_descent( + family = data$family %||% "", + face = data$fontface %||% 1, + size = data$size %||% 3.88 + ) + grob <- labelGrob( + data$label, + x = unit(just$hjust, "npc"), + y = unit(just$vjust, "npc") + descent, + angle = data$angle, + just = c(data$hjust, data$vjust), + padding = padding, + r = params$label.r, + text.gp = gpar( + col = data$colour %||% "black", + fontfamily = data$family %||% "", + fontface = data$fontface %||% 1, + fontsize = (data$size %||% 3.88) * .pt + ), + rect.gp = gpar( + col = if (isTRUE(all.equal(params$label.size, 0))) NA else data$colour, + fill = alpha(data$fill %||% "white", data$alpha), + lwd = params$label.size * .pt + ) ) + angle <- deg2rad(data$angle %||% 0) + text <- grob$children[[2]] + width <- convertWidth(grobWidth(text), "cm", valueOnly = TRUE) + height <- convertHeight(grobHeight(text), "cm", valueOnly = TRUE) + x <- c(0, 0, width, width) + y <- c(0, height, height, 0) + attr(grob, "width") <- diff(range(x * cos(angle) - y * sin(angle))) + attr(grob, "height") <- diff(range(x * sin(angle) + y * cos(angle))) + grob } #' @export From 80db793d82418179ae407a353346b4eb56f02493 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 11 Dec 2023 14:50:33 +0100 Subject: [PATCH 17/22] Long legend title justification (#5570) * justify titles when larger than legend * add test * add news bullet * apply logical to `guide_custom` too --- NEWS.md | 3 + R/guide-custom.R | 20 +++- R/guide-legend.R | 45 ++++----- .../legends-with-all-title-justifications.svg | 99 +++++++++++++++++++ tests/testthat/test-guides.R | 16 +++ 5 files changed, 155 insertions(+), 28 deletions(-) create mode 100644 tests/testthat/_snaps/guides/legends-with-all-title-justifications.svg diff --git a/NEWS.md b/NEWS.md index 0b05e50440..b848c4ce16 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* When legend titles are larger than the legend, title justification extends + to the placement of keys and labels (#1903). + * `draw_key_label()` now better reflects the appearance of labels. * The `minor_breaks` function argument in scales can now take a function with diff --git a/R/guide-custom.R b/R/guide-custom.R index bca9e0214d..4a63942d4a 100644 --- a/R/guide-custom.R +++ b/R/guide-custom.R @@ -124,11 +124,17 @@ GuideCustom <- ggproto( title.position <- "none" } - width <- convertWidth(params$width, "cm") - height <- convertHeight(params$height, "cm") - gt <- gtable(widths = width, heights = height) + width <- convertWidth(params$width, "cm", valueOnly = TRUE) + height <- convertHeight(params$height, "cm", valueOnly = TRUE) + gt <- gtable(widths = unit(width, "cm"), heights = unit(height, "cm")) gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1, clip = "off") + extra_width <- max(0, width_cm(title) - width) + extra_height <- max(0, height_cm(title) - height) + just <- with(elems$title, rotate_just(angle, hjust, vjust)) + hjust <- just$hjust + vjust <- just$vjust + if (params$title.position == "top") { gt <- gtable_add_rows(gt, elems$margin[1], pos = 0) gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = 0) @@ -146,6 +152,14 @@ GuideCustom <- ggproto( gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0) gt <- gtable_add_grob(gt, title, t = 1, l = -1, name = "title", clip = "off") } + if (params$title.position %in% c("top", "bottom")) { + gt <- gtable_add_cols(gt, unit(extra_width * hjust, "cm"), pos = 0) + gt <- gtable_add_cols(gt, unit(extra_width * (1 - hjust), "cm"), pos = -1) + } else { + gt <- gtable_add_rows(gt, unit(extra_height * (1 - vjust), "cm"), pos = 0) + gt <- gtable_add_rows(gt, unit(extra_height * vjust, "cm"), pos = -1) + } + gt <- gtable_add_padding(gt, elems$margin) background <- element_grob(elems$background) diff --git a/R/guide-legend.R b/R/guide-legend.R index 910ef12cc3..74c6547e71 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -603,19 +603,24 @@ GuideLegend <- ggproto( # Measure title title_width <- width_cm(grobs$title) title_height <- height_cm(grobs$title) + extra_width <- max(0, title_width - sum(widths)) + extra_height <- max(0, title_height - sum(heights)) + just <- with(elements$title, rotate_just(angle, hjust, vjust)) + hjust <- just$hjust + vjust <- just$vjust # Combine title with rest of the sizes based on its position widths <- switch( params$title.position, "left" = c(title_width, widths), "right" = c(widths, title_width), - c(widths, max(0, title_width - sum(widths))) + c(extra_width * hjust, widths, extra_width * (1 - hjust)) ) heights <- switch( params$title.position, "top" = c(title_height, heights), "bottom" = c(heights, title_height), - c(heights, max(0, title_height - sum(heights))) + c(extra_height * (1 - vjust), heights, extra_height * vjust) ) } @@ -670,29 +675,19 @@ GuideLegend <- ggproto( # Offset layout based on title position if (sizes$has_title) { - switch( - params$title.position, - "top" = { - key_row <- key_row + 1 - label_row <- label_row + 1 - title_row <- 2 - title_col <- seq_along(sizes$widths) + 1 - }, - "bottom" = { - title_row <- length(sizes$heights) + 1 - title_col <- seq_along(sizes$widths) + 1 - }, - "left" = { - key_col <- key_col + 1 - label_col <- label_col + 1 - title_row <- seq_along(sizes$heights) + 1 - title_col <- 2 - }, - "right" = { - title_row <- seq_along(sizes$heights) + 1 - title_col <- length(sizes$widths) + 1 - } - ) + position <- params$title.position + if (position != "right") { + key_col <- key_col + 1 + label_col <- label_col + 1 + } + if (position != "bottom") { + key_row <- key_row + 1 + label_row <- label_row + 1 + } + nrow <- length(sizes$heights) + ncol <- length(sizes$widths) + title_row <- switch(position, top = 1, bottom = nrow, seq_len(nrow)) + 1 + title_col <- switch(position, left = 1, right = ncol, seq_len(ncol)) + 1 } else { title_row <- NA title_col <- NA diff --git a/tests/testthat/_snaps/guides/legends-with-all-title-justifications.svg b/tests/testthat/_snaps/guides/legends-with-all-title-justifications.svg new file mode 100644 index 0000000000..94011b6f1f --- /dev/null +++ b/tests/testthat/_snaps/guides/legends-with-all-title-justifications.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 + + + + + + + + + + +1.00 +1.25 +1.50 +1.75 +2.00 +x +x + +colour title with hjust = 0 + + + + +1 +2 + +fill title with hjust = 1 + + + + +1 +2 + +Title +for +alpha +with +vjust=0 + + + + +1 +2 + +Title +for +shape +with +vjust=1 + + + + +1 +2 +legends with all title justifications + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 69b7bb558c..2bee90f460 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -831,6 +831,22 @@ test_that("guides title and text are positioned correctly", { ) expect_doppelganger("rotated guide titles and labels", p ) + + # title justification + p <- ggplot(data.frame(x = 1:2)) + + aes(x, x, colour = factor(x), fill = factor(x), shape = factor(x), alpha = x) + + geom_point() + + scale_alpha(breaks = 1:2) + + guides( + colour = guide_legend("colour title with hjust = 0", title.hjust = 0, order = 1), + fill = guide_legend("fill title with hjust = 1", title.hjust = 1, order = 2, + title.position = "bottom", override.aes = list(shape = 21)), + alpha = guide_legend("Title\nfor\nalpha\nwith\nvjust=0", title.vjust = 0, + title.position = "left", order = 3), + shape = guide_legend("Title\nfor\nshape\nwith\nvjust=1", title.vjust = 1, + title.position = "right", order = 4) + ) + expect_doppelganger("legends with all title justifications", p) }) test_that("size and linewidth affect key size", { From 5ed2d88d79a0986b913ca740a609ad7660388a19 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 11 Dec 2023 15:27:14 +0100 Subject: [PATCH 18/22] Stretching legends (#5515) * colourbar size is defined in npcs * backport `unitType` * guide assembly preserves null units * Handle null units at guide boxes * set legend size to 1npc during build * better unit recognitionin R3.6 * smart distribution of null units * better detection of relative legend sizes * document use of null units * Add tests * Adapt to #5488 * Fix title spacing bug --- R/backports.R | 20 +++++ R/guide-colorbar.R | 27 +++--- R/guide-legend.R | 42 ++++++--- R/guides-.R | 90 +++++++++++++++++-- man/guide_bins.Rd | 12 ++- man/guide_colourbar.Rd | 12 ++- man/guide_coloursteps.Rd | 11 ++- man/guide_legend.Rd | 12 ++- .../theme/stretched-horizontal-legends.svg | 90 +++++++++++++++++++ .../theme/stretched-vertical-legends.svg | 90 +++++++++++++++++++ tests/testthat/test-theme.R | 33 +++++++ 11 files changed, 377 insertions(+), 62 deletions(-) create mode 100644 tests/testthat/_snaps/theme/stretched-horizontal-legends.svg create mode 100644 tests/testthat/_snaps/theme/stretched-vertical-legends.svg diff --git a/R/backports.R b/R/backports.R index 0fe48cc3ac..c19197e09b 100644 --- a/R/backports.R +++ b/R/backports.R @@ -17,6 +17,26 @@ if (getRversion() < "3.3") { on_load(backport_unit_methods()) +unitType <- function(x) { + unit <- attr(x, "unit") + if (!is.null(unit)) { + return(unit) + } + if (is.list(x) && is.unit(x[[1]])) { + unit <- vapply(x, unitType, character(1)) + return(unit) + } else if ("fname" %in% names(x)) { + return(x$fname) + } + rep("", length(x)) # we're only interested in simple units for now +} + +on_load({ + if ("unitType" %in% getNamespaceExports("grid")) { + unitType <- grid::unitType + } +}) + # isFALSE() and isTRUE() are available on R (>=3.5) if (getRversion() < "3.5") { isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 374f8ac92e..df2362b717 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -15,12 +15,11 @@ NULL #' see [guides()]. #' #' @inheritParams guide_legend -#' @param barwidth A numeric or a [grid::unit()] object specifying -#' the width of the colourbar. Default value is `legend.key.width` or -#' `legend.key.size` in [theme()] or theme. -#' @param barheight A numeric or a [grid::unit()] object specifying -#' the height of the colourbar. Default value is `legend.key.height` or -#' `legend.key.size` in [theme()] or theme. +#' @param barwidth,barheight A numeric or [grid::unit()] object specifying the +#' width and height of the bar respectively. Default value is derived from +#' `legend.key.width`, `legend.key.height` or `legend.key` in [theme()].\cr +#' `r lifecycle::badge("experimental")`: optionally a `"null"` unit to stretch +#' the bar to the available space. #' @param frame A theme object for rendering a frame drawn around the bar. #' Usually, the object of `element_rect()` is expected. If `element_blank()` #' (default), no frame is drawn. @@ -452,21 +451,21 @@ GuideColourbar <- ggproto( ) grob <- rasterGrob( image = image, - width = elements$key.width, - height = elements$key.height, - default.units = "cm", + width = 1, + height = 1, + default.units = "npc", gp = gpar(col = NA), interpolate = TRUE ) } else{ if (params$direction == "horizontal") { - width <- elements$key.width / nrow(decor) - height <- elements$key.height + width <- 1 / nrow(decor) + height <- 1 x <- (seq(nrow(decor)) - 1) * width y <- 0 } else { - width <- elements$key.width - height <- elements$key.height / nrow(decor) + width <- 1 + height <- 1 / nrow(decor) y <- (seq(nrow(decor)) - 1) * height x <- 0 } @@ -474,7 +473,7 @@ GuideColourbar <- ggproto( x = x, y = y, vjust = 0, hjust = 0, width = width, height = height, - default.units = "cm", + default.units = "npc", gp = gpar(col = NA, fill = decor$colour) ) } diff --git a/R/guide-legend.R b/R/guide-legend.R index 74c6547e71..324e5b81f7 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -36,12 +36,11 @@ #' (right-aligned) for expressions. #' @param label.vjust A numeric specifying vertical justification of the label #' text. -#' @param keywidth A numeric or a [grid::unit()] object specifying -#' the width of the legend key. Default value is `legend.key.width` or -#' `legend.key.size` in [theme()]. -#' @param keyheight A numeric or a [grid::unit()] object specifying -#' the height of the legend key. Default value is `legend.key.height` or -#' `legend.key.size` in [theme()]. +#' @param keywidth,keyheight A numeric or [grid::unit()] object specifying the +#' width and height of the legend key respectively. Default value is +#' `legend.key.width`, `legend.key.height` or `legend.key` in [theme()].\cr +#' `r lifecycle::badge("experimental")`: optionally a `"null"` unit to stretch +#' keys to the available space. #' @param key.spacing,key.spacing.x,key.spacing.y A numeric or [grid::unit()] #' object specifying the distance between key-label pairs in the horizontal #' direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both @@ -603,8 +602,19 @@ GuideLegend <- ggproto( # Measure title title_width <- width_cm(grobs$title) title_height <- height_cm(grobs$title) - extra_width <- max(0, title_width - sum(widths)) - extra_height <- max(0, title_height - sum(heights)) + + # Titles are assumed to have sufficient size when keys are null units + if (is.unit(params$keywidth) && unitType(params$keywidth) == "null") { + extra_width <- 0 + } else { + extra_width <- max(0, title_width - sum(widths)) + } + if (is.unit(params$keyheight) && unitType(params$keyheight) == "null") { + extra_height <- 0 + } else { + extra_height <- max(0, title_height - sum(heights)) + } + just <- with(elements$title, rotate_just(angle, hjust, vjust)) hjust <- just$hjust vjust <- just$vjust @@ -699,11 +709,19 @@ GuideLegend <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { + widths <- unit(c(sizes$padding[4], sizes$widths, sizes$padding[2]), "cm") + if (is.unit(params$keywidth) && unitType(params$keywidth) == "null") { + i <- unique(layout$layout$key_col) + widths[i] <- params$keywidth + } - gt <- gtable( - widths = unit(c(sizes$padding[4], sizes$widths, sizes$padding[2]), "cm"), - heights = unit(c(sizes$padding[1], sizes$heights, sizes$padding[3]), "cm") - ) + heights <- unit(c(sizes$padding[1], sizes$heights, sizes$padding[3]), "cm") + if (is.unit(params$keyheight) && unitType(params$keyheight) == "null") { + i <- unique(layout$layout$key_row) + heights[i] <- params$keyheight + } + + gt <- gtable(widths = widths, heights = heights) # Add background if (!is.zero(elements$background)) { diff --git a/R/guides-.R b/R/guides-.R index c44fc06907..4558f1e821 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -572,10 +572,12 @@ Guides <- ggproto( ) # Measure guides - widths <- lapply(grobs, function(g) sum(g$widths)) - widths <- inject(unit.c(!!!widths)) - heights <- lapply(grobs, function(g) sum(g$heights)) - heights <- inject(unit.c(!!!heights)) + widths <- lapply(grobs, `[[`, "widths") + heights <- lapply(grobs, `[[`, "heights") + + # Check whether legends are stretched in some direction + stretch_x <- any(unlist(lapply(widths, unitType)) == "null") + stretch_y <- any(unlist(lapply(heights, unitType)) == "null") # Global justification of the complete legend box global_just <- paste0("legend.justification.", position) @@ -605,6 +607,8 @@ Guides <- ggproto( box_xjust <- box_just[1] box_yjust <- box_just[2] + margin <- theme$legend.box.margin %||% margin() + # setting that is different for vertical and horizontal guide-boxes. if (identical(theme$legend.box, "horizontal")) { # Set justification for each legend within the box @@ -615,13 +619,23 @@ Guides <- ggproto( height = heightDetails(grobs[[i]])) ) } - spacing <- theme$legend.spacing.x + + spacing <- convertWidth(theme$legend.spacing.x, "cm") + heights <- unit(height_cm(lapply(heights, sum)), "cm") + + if (stretch_x) { + widths <- redistribute_null_units(widths, spacing, margin, "width") + vp_width <- unit(1, "npc") + } else { + widths <- inject(unit.c(!!!lapply(widths, sum))) + vp_width <- sum(widths, spacing * (length(grobs) - 1L)) + } # Set global justification vp <- viewport( x = global_xjust, y = global_yjust, just = global_just, height = max(heights), - width = sum(widths, spacing * (length(grobs) - 1L)) + width = vp_width ) # Initialise gtable as legends in a row @@ -643,12 +657,22 @@ Guides <- ggproto( width = widthDetails(grobs[[i]])) ) } - spacing <- theme$legend.spacing.y + + spacing <- convertHeight(theme$legend.spacing.y, "cm") + widths <- unit(width_cm(lapply(widths, sum)), "cm") + + if (stretch_y) { + heights <- redistribute_null_units(heights, spacing, margin, "height") + vp_height <- unit(1, "npc") + } else { + heights <- inject(unit.c(!!!lapply(heights, sum))) + vp_height <- sum(heights, spacing * (length(grobs) - 1L)) + } # Set global justification vp <- viewport( x = global_xjust, y = global_yjust, just = global_just, - height = sum(heights, spacing * (length(grobs) - 1L)), + height = vp_height, width = max(widths) ) @@ -664,7 +688,6 @@ Guides <- ggproto( } # Add margins around the guide-boxes. - margin <- theme$legend.box.margin %||% margin() guides <- gtable_add_padding(guides, margin) # Add legend box background @@ -678,6 +701,12 @@ Guides <- ggproto( ) # Set global margin + if (stretch_x) { + global_margin[c(2, 4)] <- unit(0, "cm") + } + if (stretch_y) { + global_margin[c(1, 3)] <- unit(0, "cm") + } guides <- gtable_add_padding(guides, global_margin) guides$name <- "guide-box" @@ -793,3 +822,46 @@ validate_guide <- function(guide) { } cli::cli_abort("Unknown guide: {guide}") } + +redistribute_null_units <- function(units, spacing, margin, type = "width") { + + has_null <- vapply(units, function(x) any(unitType(x) == "null"), logical(1)) + + # Early exit when we needn't bother with null units + if (!any(has_null)) { + units <- lapply(units, sum) + units <- inject(unit.c(!!!units)) + return(units) + } + + # Get spacing between guides and margins in absolute units + size <- switch(type, width = convertWidth, height = convertHeight) + spacing <- size(spacing, "cm", valueOnly = TRUE) + spacing <- sum(rep(spacing, length(units) - 1)) + margin <- switch(type, width = margin[c(2, 4)], height = margin[c(1, 3)]) + margin <- sum(size(margin, "cm", valueOnly = TRUE)) + + # Get the absolute parts of the unit + absolute <- vapply(units, function(u) { + u <- absolute.size(u) + u <- size(u, "cm", valueOnly = TRUE) + sum(u) + }, numeric(1)) + absolute_sum <- sum(absolute) + spacing + margin + + # Get the null parts of the unit + relative <- rep(0, length(units)) + relative[has_null] <- vapply(units[has_null], function(u) { + sum(as.numeric(u)[unitType(u) == "null"]) + }, numeric(1)) + relative_sum <- sum(relative) + + if (relative_sum == 0) { + return(unit(absolute, "cm")) + } + + relative <- relative / relative_sum + available_space <- unit(1, "npc") - unit(absolute_sum, "cm") + relative_space <- available_space * relative + relative_space + unit(absolute, "cm") +} diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 811037d474..59faaa8050 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -71,13 +71,11 @@ label text. The default for standard text is 0 (left-aligned) and 1 \item{label.vjust}{A numeric specifying vertical justification of the label text.} -\item{keywidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the width of the legend key. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link[=theme]{theme()}}.} - -\item{keyheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the height of the legend key. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link[=theme]{theme()}}.} +\item{keywidth, keyheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the +width and height of the legend key respectively. Default value is +\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch +keys to the available space.} \item{axis}{A theme object for rendering a small axis along the guide. Usually, the object of \code{element_line()} is expected (default). If diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 8273ec4326..045396216e 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -111,13 +111,11 @@ label text. The default for standard text is 0 (left-aligned) and 1 \item{label.vjust}{A numeric specifying vertical justification of the label text.} -\item{barwidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the width of the colourbar. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} - -\item{barheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the height of the colourbar. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} +\item{barwidth, barheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the +width and height of the bar respectively. Default value is derived from +\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch +the bar to the available space.} \item{nbin}{A numeric specifying the number of bins for drawing the colourbar. A smoother colourbar results from a larger value.} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index d77895415e..4a8b42bdd9 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -38,12 +38,11 @@ be a logical which translates \code{TRUE} to \code{element_line()} and \code{FAL \item{...}{ Arguments passed on to \code{\link[=guide_colourbar]{guide_colourbar}} \describe{ - \item{\code{barwidth}}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the width of the colourbar. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} - \item{\code{barheight}}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the height of the colourbar. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link[=theme]{theme()}} or theme.} + \item{\code{barwidth,barheight}}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the +width and height of the bar respectively. Default value is derived from +\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch +the bar to the available space.} \item{\code{frame}}{A theme object for rendering a frame drawn around the bar. Usually, the object of \code{element_rect()} is expected. If \code{element_blank()} (default), no frame is drawn.} diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index 75e965adfc..bfd498defc 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -70,13 +70,11 @@ label text. The default for standard text is 0 (left-aligned) and 1 \item{label.vjust}{A numeric specifying vertical justification of the label text.} -\item{keywidth}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the width of the legend key. Default value is \code{legend.key.width} or -\code{legend.key.size} in \code{\link[=theme]{theme()}}.} - -\item{keyheight}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying -the height of the legend key. Default value is \code{legend.key.height} or -\code{legend.key.size} in \code{\link[=theme]{theme()}}.} +\item{keywidth, keyheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the +width and height of the legend key respectively. Default value is +\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch +keys to the available space.} \item{key.spacing, key.spacing.x, key.spacing.y}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the distance between key-label pairs in the horizontal diff --git a/tests/testthat/_snaps/theme/stretched-horizontal-legends.svg b/tests/testthat/_snaps/theme/stretched-horizontal-legends.svg new file mode 100644 index 0000000000..daa1c3c43e --- /dev/null +++ b/tests/testthat/_snaps/theme/stretched-horizontal-legends.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + + +a + + + + + + +a +b +c + +x + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +stretched horizontal legends + + diff --git a/tests/testthat/_snaps/theme/stretched-vertical-legends.svg b/tests/testthat/_snaps/theme/stretched-vertical-legends.svg new file mode 100644 index 0000000000..8fa4c8a8b6 --- /dev/null +++ b/tests/testthat/_snaps/theme/stretched-vertical-legends.svg @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +x +y + + +a + + + + + + +a +b +c + +x + + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +stretched vertical legends + + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index af6a4b670a..dcaba82966 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -793,3 +793,36 @@ test_that("Strips can render custom elements", { theme(strip.text = element_test()) expect_doppelganger("custom strip elements can render", plot) }) + +test_that("legend margins are correct when using relative key sizes", { + + df <- data_frame(x = 1:3, y = 1:3, a = letters[1:3]) + p <- ggplot(df, aes(x, y, colour = x, shape = a)) + + geom_point() + + theme_test() + + theme( + legend.box.background = element_rect(colour = "blue", fill = NA), + legend.background = element_rect(colour = "red", fill = NA) + ) + + vertical <- p + guides( + colour = guide_colourbar(barheight = unit(1, "null")), + shape = guide_legend(keyheight = unit(1/3, "null")) + ) + theme( + legend.box.margin = margin(t = 5, b = 10, unit = "mm"), + legend.margin = margin(t = 10, b = 5, unit = "mm") + ) + + expect_doppelganger("stretched vertical legends", vertical) + + horizontal <- p + guides( + colour = guide_colourbar(barwidth = unit(1, "null")), + shape = guide_legend(keywidth = unit(1/3, "null")) + ) + theme( + legend.position = "top", + legend.box.margin = margin(l = 5, r = 10, unit = "mm"), + legend.margin = margin(l = 10, r = 5, unit = "mm") + ) + + expect_doppelganger("stretched horizontal legends", horizontal) +}) From a85b06cec0fc76bdba184add61cf6d373cf30337 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 13 Dec 2023 08:01:19 +0100 Subject: [PATCH 19/22] Add Teun as author (#5573) --- DESCRIPTION | 2 ++ GOVERNANCE.md | 1 + 2 files changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 1481517272..dd4fc7d56b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,6 +18,8 @@ Authors@R: c( comment = c(ORCID = "0000-0002-3385-7233")), person("Dewey", "Dunnington", role = "aut", comment = c(ORCID = "0000-0002-9415-4582")), + person("Teun", "van den Brand", role = "aut", + comment = c(ORCID = "0000-0002-9335-7468")), person("Posit, PBC", role = c("cph", "fnd")) ) Description: A system for 'declaratively' creating graphics, based on "The diff --git a/GOVERNANCE.md b/GOVERNANCE.md index 5360a7f014..c6b8272c31 100644 --- a/GOVERNANCE.md +++ b/GOVERNANCE.md @@ -44,6 +44,7 @@ The core developers of ggplot2 are: * [Kara Woo](https://github.com/karawoo) * [Hiroaki Yutani](https://github.com/yutannihilation) * [Dewey Dunnington](https://github.com/paleolimbot) +* [Teun van den Brand](https://github.com/teunbrand) All core developers are bound by the [code of conduct](CODE_OF_CONDUCT.md). From 61142ae60945b3a18a83d16a97801b662cf09b5e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 13 Dec 2023 09:38:16 +0100 Subject: [PATCH 20/22] Fix expression label bug (#5577) --- R/guide-axis-theta.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index c8c8fa3619..47be994523 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -185,7 +185,7 @@ GuideAxisTheta <- ggproto( key <- vec_slice(key, !vec_detect_missing(key$.label %||% NA)) # Early exit if drawing no labels - labels <- key$.label + labels <- validate_labels(key$.label) if (length(labels) < 1) { return(zeroGrob()) } @@ -255,7 +255,7 @@ GuideAxisTheta <- ggproto( key <- params$key key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label)) - labels <- key$.label + labels <- validate_labels(key$.label) if (length(labels) == 0 || inherits(elements$text, "element_blank")) { return(list(offset = offset)) } From 8e1c085355d2f3fac89ebff7f1650fe5eede64fd Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 13 Dec 2023 10:04:31 +0100 Subject: [PATCH 21/22] Refactor guide styling (#5554) * add more legend theme settings * remove elements as part of guide construction * add `theme` as required guide parameter * bequeath axes with `theme` argument * wire `theme` into legends * impart `theme` upon colourbars * entrust bins guide with `theme` * replacement utility * redocument * small tweaks * backward compatibility mechanism * add news bullet * update tests * Separate colourbar/coloursteps constructors * themes have default `legend.key.spacing` * doc fixes * add `theme` to stacked axis * There is no need for `justify_grobs()` * update `replace_null()` * fix examples * adapt to latest changes * rename argument * Fix typo * no need to use `justify_grobs()` --- DESCRIPTION | 2 +- NEWS.md | 7 + R/guide-.R | 25 +- R/guide-axis-logticks.R | 2 + R/guide-axis-stack.R | 5 +- R/guide-axis-theta.R | 2 +- R/guide-axis.R | 25 +- R/guide-bins.R | 189 ++---- R/guide-colorbar.R | 281 +++------ R/guide-colorsteps.R | 32 +- R/guide-legend.R | 572 +++++++++--------- R/theme-defaults.R | 5 + R/theme-elements.R | 10 + R/theme.R | 47 +- R/utilities.R | 19 + man/element.Rd | 20 +- man/guide_axis.Rd | 5 + man/guide_axis_logticks.Rd | 5 + man/guide_axis_stack.Rd | 5 + man/guide_axis_theta.Rd | 5 + man/guide_bins.Rd | 89 +-- man/guide_colourbar.Rd | 145 +---- man/guide_coloursteps.Rd | 101 +--- man/guide_legend.Rd | 111 +--- man/theme.Rd | 33 + tests/testthat/_snaps/guides.md | 8 +- .../_snaps/guides/left-aligned-legend-key.svg | 16 +- tests/testthat/test-guides.R | 105 +++- tests/testthat/test-theme.R | 8 +- 29 files changed, 778 insertions(+), 1101 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dd4fc7d56b..349f905e59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -175,6 +175,7 @@ Collate: 'grob-dotstack.R' 'grob-null.R' 'grouping.R' + 'theme-elements.R' 'guide-.R' 'guide-axis.R' 'guide-axis-logticks.R' @@ -269,7 +270,6 @@ Collate: 'stat-ydensity.R' 'summarise-plot.R' 'summary.R' - 'theme-elements.R' 'theme.R' 'theme-defaults.R' 'theme-current.R' diff --git a/NEWS.md b/NEWS.md index b848c4ce16..db9d477402 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # ggplot2 (development version) +* `guide_*()` functions get a new `theme` argument to style individual guides. + The `theme()` function has gained additional arguments for styling guides: + `legend.key.spacing{.x/.y}`, `legend.frame`, `legend.axis.line`, + `legend.ticks`, `legend.ticks.length`, `legend.text.position` and + `legend.title.position`. Previous style arguments in the `guide_*()` functions + have been soft-deprecated. + * When legend titles are larger than the legend, title justification extends to the placement of keys and labels (#1903). diff --git a/R/guide-.R b/R/guide-.R index 85fb5ee942..b90c7b93f4 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -1,3 +1,6 @@ +#' @include theme-elements.R +NULL + #' Guide constructor #' #' A constructor function for guides, which performs some standard compatibility @@ -25,13 +28,8 @@ new_guide <- function(..., available_aes = "any", super) { params <- intersect(names(args), param_names) params <- defaults(args[params], super$params) - # Set elements - elems_names <- names(super$elements) - elems <- intersect(names(args), elems_names) - elems <- defaults(args[elems], super$elements) - # Warn about extra arguments - extra_args <- setdiff(names(args), union(param_names, elems_names)) + extra_args <- setdiff(names(args), param_names) if (length(extra_args) > 0) { cli::cli_warn(paste0( "Ignoring unknown {cli::qty(extra_args)} argument{?s} to ", @@ -50,14 +48,20 @@ new_guide <- function(..., available_aes = "any", super) { )) } + # Validate theme settings + if (!is.null(params$theme)) { + check_object(params$theme, is.theme, what = "a {.cls theme} object") + validate_theme(params$theme) + params$direction <- params$direction %||% params$theme$legend.direction + } + # Ensure 'order' is length 1 integer params$order <- vec_cast(params$order, 0L, x_arg = "order", call = pf) vec_assert(params$order, 0L, size = 1L, arg = "order", call = pf) ggproto( NULL, super, - params = params, - elements = elems, + params = params, available_aes = available_aes ) } @@ -162,6 +166,7 @@ Guide <- ggproto( # `GuidesList` class. params = list( title = waiver(), + theme = NULL, name = character(), position = waiver(), direction = NULL, @@ -275,6 +280,7 @@ Guide <- ggproto( # Converts the `elements` field to proper elements to be accepted by # `element_grob()`. String-interpolates aesthetic/position dependent elements. setup_elements = function(params, elements, theme) { + theme <- add_theme(theme, params$theme) is_char <- vapply(elements, is.character, logical(1)) elements[is_char] <- lapply(elements[is_char], calc_element, theme = theme) elements @@ -294,8 +300,7 @@ Guide <- ggproto( key <- params$key # Setup parameters and theme - params$position <- params$position %||% position - params$direction <- params$direction %||% direction + params <- replace_null(params, position = position, direction = direction) params <- self$setup_params(params) elems <- self$setup_elements(params, self$elements, theme) elems <- self$override_elements(params, elems, theme) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 699b52aee2..d7742c8cc6 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -72,6 +72,7 @@ guide_axis_logticks <- function( short_theme = element_line(), expanded = TRUE, cap = "none", + theme = NULL, ... ) { if (is.logical(cap)) { @@ -108,6 +109,7 @@ guide_axis_logticks <- function( cap = cap, minor.ticks = TRUE, short_theme = short_theme, + theme = theme, ..., super = GuideAxisLogticks ) diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R index 2fdd73b34e..1e0f765898 100644 --- a/R/guide-axis-stack.R +++ b/R/guide-axis-stack.R @@ -29,7 +29,7 @@ NULL #' #' # A normal axis first, then a capped axis #' p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both"))) -guide_axis_stack <- function(first = "axis", ..., title = waiver(), +guide_axis_stack <- function(first = "axis", ..., title = waiver(), theme = NULL, spacing = NULL, order = 0, position = waiver()) { check_object(spacing, is.unit, "{.cls unit}", allow_null = TRUE) @@ -63,6 +63,7 @@ guide_axis_stack <- function(first = "axis", ..., title = waiver(), new_guide( title = title, + theme = theme, guides = axes, guide_params = params, available_aes = c("x", "y", "theta", "r"), @@ -88,6 +89,7 @@ GuideAxisStack <- ggproto( # Standard guide stuff name = "stacked_axis", title = waiver(), + theme = NULL, angle = waiver(), hash = character(), position = waiver(), @@ -142,6 +144,7 @@ GuideAxisStack <- ggproto( draw = function(self, theme, position = NULL, direction = NULL, params = self$params) { + theme <- add_theme(theme, params$theme) position <- params$position %||% position direction <- params$direction %||% direction diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 47be994523..e8f4504050 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -23,7 +23,7 @@ NULL #' #' # The `angle` argument can be used to set relative angles #' p + guides(theta = guide_axis_theta(angle = 0)) -guide_axis_theta <- function(title = waiver(), angle = waiver(), +guide_axis_theta <- function(title = waiver(), theme = NULL, angle = waiver(), minor.ticks = FALSE, cap = "none", order = 0, position = waiver()) { diff --git a/R/guide-axis.R b/R/guide-axis.R index efca81c08e..ac59ef41b4 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -46,9 +46,9 @@ #' #' # can also be used to add a duplicate guide #' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) -guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver(), - n.dodge = 1, minor.ticks = FALSE, cap = "none", - order = 0, position = waiver()) { +guide_axis <- function(title = waiver(), theme = NULL, check.overlap = FALSE, + angle = waiver(), n.dodge = 1, minor.ticks = FALSE, + cap = "none", order = 0, position = waiver()) { check_bool(minor.ticks) if (is.logical(cap)) { check_bool(cap) @@ -58,6 +58,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver() new_guide( title = title, + theme = theme, # customisations check.overlap = check.overlap, @@ -86,6 +87,7 @@ GuideAxis <- ggproto( params = list( title = waiver(), + theme = NULL, name = "axis", hash = character(), position = waiver(), @@ -225,17 +227,14 @@ GuideAxis <- ggproto( }, setup_elements = function(params, elements, theme) { - axis_elem <- c("line", "text", "ticks", "minor", "major_length", "minor_length") - is_char <- vapply(elements[axis_elem], is.character, logical(1)) - axis_elem <- axis_elem[is_char] - elements[axis_elem] <- lapply( - paste( - unlist(elements[axis_elem]), - params$aes, params$position, sep = "." - ), - calc_element, theme = theme + is_char <- vapply(elements, is.character, logical(1)) + suffix <- paste(params$aes, params$position, sep = ".") + elements[is_char] <- vapply( + elements[is_char], + function(x) paste(x, suffix, sep = "."), + character(1) ) - elements + Guide$setup_elements(params, elements, theme) }, override_elements = function(params, elements, theme) { diff --git a/R/guide-bins.R b/R/guide-bins.R index 54676378bb..c13447eb32 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -11,26 +11,11 @@ NULL #' guide if they are mapped in the same way. #' #' @inheritParams guide_legend -#' @param axis A theme object for rendering a small axis along the guide. -#' Usually, the object of `element_line()` is expected (default). If -#' `element_blank()`, no axis is drawn. For backward compatibility, can also -#' be a logical which translates `TRUE` to `element_line()` and `FALSE` to -#' `element_blank()`. -#' @param axis.colour,axis.linewidth Graphic specifications for the look of the -#' axis. -#' @param axis.arrow A call to `arrow()` to specify arrows at the end of the -#' axis line, thus showing an open interval. #' @param show.limits Logical. Should the limits of the scale be shown with #' labels and ticks. Default is `NULL` meaning it will take the value from the #' scale. This argument is ignored if `labels` is given as a vector of #' values. If one or both of the limits is also given in `breaks` it will be #' shown irrespective of the value of `show.limits`. -#' @param ticks A theme object for rendering tick marks at the colourbar. -#' Usually, the object of `element_line()` is expected. If `element_blank()`, -#' no tick marks are drawn. If `NULL` (default), the `axis` argument is -#' re-used as `ticks` argument (without arrow). -#' @param ticks.length A numeric or a [grid::unit()] object specifying the -#' length of tick marks between the keys. #' #' @section Use with discrete scale: #' This guide is intended to show binned data and work together with ggplot2's @@ -57,12 +42,15 @@ NULL #' p #' #' # Remove the axis or style it -#' p + guides(size = guide_bins(axis = FALSE)) +#' p + guides(size = guide_bins( +#' theme = theme(legend.axis.line = element_blank()) +#' )) #' #' p + guides(size = guide_bins(show.limits = TRUE)) #' +#' my_arrow <- arrow(length = unit(1.5, "mm"), ends = "both") #' p + guides(size = guide_bins( -#' axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') +#' theme = theme(legend.axis.line = element_line(arrow = my_arrow)) #' )) #' #' # Guides are merged together if possible @@ -74,35 +62,11 @@ NULL guide_bins <- function( # title title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - - # label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - - # key - keywidth = NULL, - keyheight = NULL, - - # ticks - axis = TRUE, - axis.colour = "black", - axis.linewidth = NULL, - axis.arrow = NULL, - - ticks = NULL, - ticks.length = unit(0.2, "npc"), + theme = NULL, # general position = NULL, direction = NULL, - default.unit = "line", override.aes = list(), reverse = FALSE, order = 0, @@ -110,67 +74,15 @@ guide_bins <- function( ... ) { - if (!(is.null(keywidth) || is.unit(keywidth))) { - keywidth <- unit(keywidth, default.unit) - } - if (!(is.null(keyheight) || is.unit(keyheight))) { - keyheight <- unit(keyheight, default.unit) - } - if (!is.unit(ticks.length)) { - ticks.length <- unit(ticks.length, default.unit) - } - if (!is.null(title.position)) { - title.position <- arg_match0(title.position, .trbl) - } + theme <- deprecated_guide_args(theme, ...) if (!is.null(position)) { position <- arg_match0(position, c(.trbl, "inside")) } - if (!is.null(direction)) { - direction <- arg_match0(direction, c("horizontal", "vertical")) - } - if (!is.null(label.position)) { - label.position <- arg_match0(label.position, .trbl) - } - - if (is.logical(axis)) { - axis <- if (axis) element_line() else element_rect() - } - if (inherits(axis, "element_line")) { - axis$colour <- axis.colour %||% axis$colour %||% "black" - axis$linewidth <- axis.linewidth %||% axis$linewidth %||% (0.5 / .pt) - axis$arrow <- axis.arrow %||% axis$arrow - } else { - axis <- element_blank() - } - - if (is.null(ticks)) { - ticks <- axis - ticks$arrow <- NULL - } new_guide( # title title = title, - title.position = title.position, - title.theme = title.theme, - title.hjust = title.hjust, - title.vjust = title.vjust, - - # label - label = label, - label.position = label.position, - label.theme = label.theme, - label.hjust = label.hjust, - label.vjust = label.vjust, - - # key - keywidth = keywidth, - keyheight = keyheight, - - # ticks - line = axis, - ticks = ticks, - ticks_length = ticks.length, + theme = theme, # general position = position, @@ -197,19 +109,12 @@ GuideBins <- ggproto( params = list( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - - keywidth = NULL, - keyheight = NULL, + # theming + theme = NULL, + default_axis = element_line("black", linewidth = (0.5 / .pt)), + default_ticks = element_line(inherit.blank = TRUE), + default_tick_length = unit(0.2, "npc"), direction = NULL, override.aes = list(), @@ -226,9 +131,9 @@ GuideBins <- ggproto( elements = c( GuideLegend$elements, list( - line = "line", - ticks = "line", - ticks_length = unit(0.2, "npc") + axis_line = "legend.axis.line", + ticks_length = "legend.ticks.length", + ticks = "legend.ticks" ) ), @@ -301,43 +206,45 @@ GuideBins <- ggproto( key$.value <- 1 - key$.value } - params$title <- scale$make_title( - params$title %|W|% scale$name %|W|% title - ) + params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title) params$key <- key params }, setup_params = function(params) { - params$direction <- arg_match0( - params$direction, - c("horizontal", "vertical"), arg_nm = "direction" - ) - valid_label_pos <- switch( + params <- GuideLegend$setup_params(params) + params$nrow <- params$ncol <- params$n_breaks <- params$n_key_layers <- 1 + params + }, + + setup_elements = function(params, elements, theme) { + valid_position <- switch( params$direction, "horizontal" = c("bottom", "top"), "vertical" = c("right", "left") ) - params$label.position <- params$label.position %||% valid_label_pos[1] - if (!params$label.position %in% valid_label_pos) { + + # Set defaults + theme <- replace_null( + theme, + legend.text.position = valid_position[1], + legend.ticks.length = params$default_tick_length, + legend.axis.line = params$default_axis, + legend.ticks = params$default_ticks + ) + + # Let the legend guide handle the rest + elements <- GuideLegend$setup_elements(params, elements, theme) + + # Check text position + if (!elements$text_position %in% valid_position) { cli::cli_abort(paste0( - "When {.arg direction} is {.val {params$direction}}, ", - "{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ", - "not {.val {params$label.position}}." + "When {.arg direction} is {.val {params$direction}, ", + "{.arg legend.text.position} must be one of ", + "{.or {.val {valid_position}}}, not {.val {elements$text.position}}." )) } - params <- GuideLegend$setup_params(params) - params$byrow <- FALSE - params$rejust_labels <- FALSE - params$nrow <- params$ncol <- params$n_breaks <- params$n_key_layers <- 1 - params$multikey_decor <- FALSE - params - }, - - override_elements = function(params, elements, theme) { - elements$ticks <- combine_elements(elements$ticks, theme$line) - elements$line <- combine_elements(elements$line, theme$line) - GuideLegend$override_elements(params, elements, theme) + elements }, build_labels = function(key, elements, params) { @@ -366,7 +273,7 @@ GuideBins <- ggproto( key$.value <- 1 - key$.value } key$.value[c(1, nrow(key))[!params$show.limits]] <- NA - Guide$build_ticks(key$.value, elements, params, params$label.position) + Guide$build_ticks(key$.value, elements, params, elements$text_position) }, build_decor = function(decor, grobs, elements, params) { @@ -378,8 +285,8 @@ GuideBins <- ggproto( sizes <- measure_legend_keys( decor, nkeys, dim, byrow = FALSE, - default_width = elements$key.width, - default_height = elements$key.height + default_width = elements$width_cm, + default_height = elements$height_cm ) sizes <- lapply(sizes, function(x) rep_len(max(x), length(x))) @@ -401,13 +308,13 @@ GuideBins <- ggproto( name = key_nm, clip = "off") axis <- switch( - params$label.position, + elements$text_position, "top" = list(x = c(0, 1), y = c(1, 1)), "bottom" = list(x = c(0, 1), y = c(0, 0)), "left" = list(x = c(0, 0), y = c(0, 1)), "right" = list(x = c(1, 1), y = c(0, 1)) ) - axis <- element_grob(elements$line, x = axis$x, y = axis$y) + axis <- element_grob(elements$axis_line, x = axis$x, y = axis$y) list(keys = gt, axis_line = axis, ticks = grobs$ticks) }, diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index df2362b717..9fdc92c437 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -15,45 +15,18 @@ NULL #' see [guides()]. #' #' @inheritParams guide_legend -#' @param barwidth,barheight A numeric or [grid::unit()] object specifying the -#' width and height of the bar respectively. Default value is derived from -#' `legend.key.width`, `legend.key.height` or `legend.key` in [theme()].\cr -#' `r lifecycle::badge("experimental")`: optionally a `"null"` unit to stretch -#' the bar to the available space. -#' @param frame A theme object for rendering a frame drawn around the bar. -#' Usually, the object of `element_rect()` is expected. If `element_blank()` -#' (default), no frame is drawn. -#' @param frame.colour A string specifying the colour of the frame -#' drawn around the bar. For backward compatibility, if this argument is -#' not `NULL`, the `frame` argument will be set to `element_rect()`. -#' @param frame.linewidth A numeric specifying the width of the frame -#' drawn around the bar in millimetres. -#' @param frame.linetype A numeric specifying the linetype of the frame -#' drawn around the bar. #' @param nbin A numeric specifying the number of bins for drawing the #' colourbar. A smoother colourbar results from a larger value. #' @param raster A logical. If `TRUE` then the colourbar is rendered as a #' raster object. If `FALSE` then the colourbar is rendered as a set of #' rectangles. Note that not all graphics devices are capable of rendering #' raster image. -#' @param ticks A theme object for rendering tick marks at the colourbar. -#' Usually, the object of `element_line()` is expected (default). If -#' `element_blank()`, no tick marks are drawn. For backward compatibility, -#' can also be a logical which translates `TRUE` to `element_line()` and -#' `FALSE` to `element_blank()`. -#' @param ticks.colour A string specifying the colour of the tick marks. -#' @param ticks.linewidth A numeric specifying the width of the tick marks in -#' millimetres. -#' @param ticks.length A numeric or a [grid::unit()] object specifying the -#' length of tick marks at the colourbar. #' @param draw.ulim A logical specifying if the upper limit tick marks should #' be visible. #' @param draw.llim A logical specifying if the lower limit tick marks should #' be visible. #' @param direction A character string indicating the direction of the guide. #' One of "horizontal" or "vertical." -#' @param default.unit A character string indicating [grid::unit()] -#' for `barwidth` and `barheight`. #' @param reverse logical. If `TRUE` the colourbar is reversed. By default, #' the highest value is on the top and the lowest value is on the bottom #' @param available_aes A vector of character strings listing the aesthetics @@ -77,19 +50,31 @@ NULL #' # Control styles #' #' # bar size -#' p1 + guides(fill = guide_colourbar(barwidth = 0.5, barheight = 10)) +#' p1 + guides(fill = guide_colourbar(theme = theme( +#' legend.key.width = unit(0.5, "lines"), +#' legend.key.height = unit(10, "lines") +#' ))) +#' #' #' # no label -#' p1 + guides(fill = guide_colourbar(label = FALSE)) +#' p1 + guides(fill = guide_colourbar(theme = theme( +#' legend.text = element_blank() +#' ))) #' #' # no tick marks -#' p1 + guides(fill = guide_colourbar(ticks = FALSE)) +#' p1 + guides(fill = guide_colourbar(theme = theme( +#' legend.ticks = element_blank() +#' ))) #' #' # label position -#' p1 + guides(fill = guide_colourbar(label.position = "left")) +#' p1 + guides(fill = guide_colourbar(theme = theme( +#' legend.text.position = "left" +#' ))) #' #' # label theme -#' p1 + guides(fill = guide_colourbar(label.theme = element_text(colour = "blue", angle = 0))) +#' p1 + guides(fill = guide_colourbar(theme = theme( +#' legend.text = element_text(colour = "blue", angle = 0) +#' ))) #' #' # small number of bins #' p1 + guides(fill = guide_colourbar(nbin = 3)) @@ -102,7 +87,7 @@ NULL #' scale_fill_continuous( #' limits = c(0,20), breaks = c(0, 5, 10, 15, 20), #' guide = guide_colourbar(nbin = 100, draw.ulim = FALSE, draw.llim = FALSE) -#' ) +#' ) #' #' # guides can be controlled independently #' p2 + @@ -111,148 +96,45 @@ NULL #' p2 + guides(fill = "colourbar", size = "legend") #' #' p2 + -#' scale_fill_continuous(guide = guide_colourbar(direction = "horizontal")) + -#' scale_size(guide = guide_legend(direction = "vertical")) +#' scale_fill_continuous(guide = guide_colourbar(theme = theme( +#' legend.direction = "horizontal" +#' ))) + +#' scale_size(guide = guide_legend(theme = theme( +#' legend.direction = "vertical" +#' ))) guide_colourbar <- function( - - # title title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - - # label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - - # bar - barwidth = NULL, - barheight = NULL, + theme = NULL, nbin = 300, raster = TRUE, - - # frame - frame = element_blank(), - frame.colour = NULL, - frame.linewidth = NULL, - frame.linetype = NULL, - - # ticks - ticks = element_line(), - ticks.colour = NULL, - ticks.linewidth = NULL, - ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, - - # general position = NULL, direction = NULL, - default.unit = "line", reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), ... ) { - if (!(is.null(barwidth) || is.unit(barwidth))) { - barwidth <- unit(barwidth, default.unit) - } - if (!(is.null(barheight) || is.unit(barheight))) { - barheight <- unit(barheight, default.unit) - } - if (!is.unit(ticks.length)) { - ticks.length <- unit(ticks.length, default.unit) - } - if (!is.null(title.position)) { - title.position <- arg_match0(title.position, .trbl) - } + theme <- deprecated_guide_args(theme, ...) if (!is.null(position)) { position <- arg_match0(position, c(.trbl, "inside")) } - if (!is.null(direction)) { - direction <- arg_match0(direction, c("horizontal", "vertical")) - } - if (!is.null(label.position)) { - label.position <- arg_match0(label.position, .trbl) - } - - if (!is.null(frame.colour) && !inherits(frame, "element_rect")) { - # For backward compatibility, frame should not be element_blank when - # colour is not NULL - cli::cli_inform(c(paste0( - "If {.arg frame.colour} is set, {.arg frame} should not be ", - "{.cls {class(frame)[[1]]}}." - ), "i" = "{.arg frame} has been converted to {.cls element_rect}.")) - frame <- element_rect() - } - if (inherits(frame, "element_rect")) { - frame$colour <- frame.colour %||% frame$colour - frame$linewidth <- frame.linewidth %||% frame$linewidth %||% (0.5 / .pt) - frame$linetype <- frame.linetype %||% frame$linetype %||% 1 - } else { - frame <- element_blank() - } - - if (is.logical(ticks)) { - # Also for backward compatibility. `ticks = FALSE` used to mean: don't draw - # the ticks - ticks <- if (ticks) element_line() else element_blank() - } - if (inherits(ticks, "element_line")) { - ticks$colour <- ticks.colour %||% ticks$colour %||% "white" - ticks$linewidth <- ticks.linewidth %||% ticks$linewidth %||% (0.5 / .pt) - } - - # Trick to re-use this constructor in `guide_coloursteps()`. - args <- list2(...) - super <- args$super %||% GuideColourbar - args$super <- NULL new_guide( - # title title = title, - title.position = title.position, - title.theme = title.theme, - title.hjust = title.hjust, - title.vjust = title.vjust, - - # label - label = label, - label.position = label.position, - label.theme = label.theme, - label.hjust = label.hjust, - label.vjust = label.vjust, - - # bar - keywidth = barwidth, - keyheight = barheight, + theme = theme, nbin = nbin, raster = raster, - - # frame - frame = frame, - - # ticks - ticks = ticks, - ticks_length = ticks.length, draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)), - - # general position = position, direction = direction, reverse = reverse, order = order, - - # parameter available_aes = available_aes, name = "colourbar", - !!!args, - super = super + super = GuideColourbar ) } @@ -270,21 +152,14 @@ GuideColourbar <- ggproto( params = list( # title title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - - # label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, + + # theming + theme = NULL, + default_ticks = element_line(colour = "white", linewidth = 0.5 / .pt), + default_frame = element_blank(), + default_tick_length = unit(0.2, "npc"), # bar - keywidth = NULL, - keyheight = NULL, nbin = 300, raster = TRUE, @@ -306,16 +181,19 @@ GuideColourbar <- ggproto( hashables = exprs(title, key$.label, decor, name), elements = list( - frame = "rect", - ticks = "line", - ticks_length = unit(0.2, "npc"), - background = "legend.background", - margin = "legend.margin", - key = "legend.key", - key.height = "legend.key.height", - key.width = "legend.key.width", - text = "legend.text", - theme.title = "legend.title" + background = "legend.background", + margin = "legend.margin", + key = "legend.key", + key_height = "legend.key.height", + key_width = "legend.key.width", + text = "legend.text", + theme.title = "legend.title", + text_position = "legend.text.position", + title_position = "legend.title.position", + axis_line = "legend.axis.line", + ticks = "legend.ticks", + ticks_length = "legend.ticks.length", + frame = "legend.frame" ), extract_key = function(scale, aesthetic, ...) { @@ -346,11 +224,9 @@ GuideColourbar <- ggproto( extract_params = function(scale, params, title = waiver(), ...) { - params$title <- scale$make_title( - params$title %|W|% scale$name %|W|% title - ) + params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title) - limits <- c(params$decor$value[1], params$decor$value[nrow(params$decor)]) + limits <- params$decor$value[c(1L, nrow(params$decor))] params$key$.value <- rescale( params$key$.value, c(0.5, params$nbin - 0.5) / params$nbin, @@ -374,38 +250,41 @@ GuideColourbar <- ggproto( params$direction, c("horizontal", "vertical"), arg_nm = "direction" ) - valid_label_pos <- switch( - params$direction, - "horizontal" = c("bottom", "top"), - "vertical" = c("right", "left") - ) - params$label.position <- params$label.position %||% valid_label_pos[1] - if (!params$label.position %in% valid_label_pos) { - cli::cli_abort(paste0( - "When {.arg direction} is {.val {params$direction}}, ", - "{.arg label.position} must be one of {.or {.val {valid_label_pos}}}, ", - "not {.val {params$label.position}}." - )) - } - params$title.position <- arg_match0( - params$title.position %||% - switch(params$direction, vertical = "top", horizontal = "left"), - .trbl, arg_nm = "title.position" - ) - params$rejust_labels <- FALSE params }, - override_elements = function(params, elements, theme) { - # These key sizes are the defaults, the GuideLegend method may overrule this + setup_elements = function(params, elements, theme) { + # We set the defaults in `theme` so that the `params$theme` can still + # overrule defaults given here if (params$direction == "horizontal") { - elements$key.width <- elements$key.width * 5 + theme$legend.key.width <- theme$legend.key.width * 5 + valid_position <- c("bottom", "top") } else { - elements$key.height <- elements$key.height * 5 + theme$legend.key.height <- theme$legend.key.height * 5 + valid_position <- c("right", "left") + } + + # Set defaults + theme <- replace_null( + theme, + legend.text.position = valid_position[1], + legend.ticks.length = params$default_tick_length, + legend.ticks = params$default_ticks, + legend.frame = params$default_frame + ) + + # Let the legend guide handle the rest + elements <- GuideLegend$setup_elements(params, elements, theme) + + # Check text position + if (!elements$text_position %in% valid_position) { + cli::cli_abort(paste0( + "When {.arg direction} is {.val {params$direction}}, ", + "{.arg legend.text.position} must be one of ", + "{.or {.val {valid_position}}}, not {.val {elements$text_position}}." + )) } - elements$ticks <- combine_elements(elements$ticks, theme$line) - elements$frame <- combine_elements(elements$frame, theme$rect) - GuideLegend$override_elements(params, elements, theme) + elements }, build_labels = function(key, elements, params) { @@ -485,8 +364,8 @@ GuideColourbar <- ggproto( measure_grobs = function(grobs, params, elements) { params$sizes <- list( - widths = elements$key.width, - heights = elements$key.height + widths = elements$width_cm, + heights = elements$height_cm ) GuideLegend$measure_grobs(grobs, params, elements) } diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index 7206a4c19e..45d0bed2d7 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -11,12 +11,7 @@ #' scale. This argument is ignored if `labels` is given as a vector of #' values. If one or both of the limits is also given in `breaks` it will be #' shown irrespective of the value of `show.limits`. -#' @param ticks A theme object for rendering tick marks at the colourbar. -#' Usually, the object of `element_line()` is expected. If `element_blank()` -#' (default), no tick marks are drawn. For backward compatibility, can also -#' be a logical which translates `TRUE` to `element_line()` and `FALSE` to -#' `element_blank()`. -#' @inheritDotParams guide_colourbar -nbin -raster -ticks -available_aes +#' @inheritParams guide_colourbar #' #' @inheritSection guide_bins Use with discrete scale #' @@ -49,17 +44,28 @@ #' # (can also be set in the scale) #' p + scale_fill_binned(show.limits = TRUE) guide_coloursteps <- function( + title = waiver(), + theme = NULL, even.steps = TRUE, show.limits = NULL, - ticks = element_blank(), + direction = NULL, + reverse = FALSE, + order = 0, + available_aes = c("colour", "color", "fill"), ... ) { - guide_colourbar( + + theme <- deprecated_guide_args(theme, ...) + + new_guide( + title = title, + theme = theme, even.steps = even.steps, show.limits = show.limits, - ticks = ticks, - ..., - super = GuideColoursteps + direction = direction, + reverse = reverse, + order = order, + super = GuideColoursteps ) } @@ -76,7 +82,7 @@ GuideColoursteps <- ggproto( params = c( list(even.steps = TRUE, show.limits = NULL), - GuideColourbar$params + vec_assign(GuideColourbar$params, "default_ticks", list(element_blank())) ), extract_key = function(scale, aesthetic, even.steps, ...) { @@ -94,7 +100,7 @@ GuideColoursteps <- ggproto( limits <- parsed$limits breaks <- parsed$breaks - key <- data_frame(scale$map(breaks), .name_repair = ~ aesthetic) + key <- data_frame0(!!aesthetic := scale$map(breaks)) key$.value <- seq_along(breaks) key$.label <- scale$get_labels(breaks) diff --git a/R/guide-legend.R b/R/guide-legend.R index 324e5b81f7..26a0b401b0 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -13,50 +13,17 @@ #' If `NULL`, the title is not shown. By default #' ([waiver()]), the name of the scale object or the name #' specified in [labs()] is used for the title. -#' @param title.position A character string indicating the position of a -#' title. One of "top" (default for a vertical guide), "bottom", "left" -#' (default for a horizontal guide), or "right." -#' @param title.theme A theme object for rendering the title text. Usually the -#' object of [element_text()] is expected. By default, the theme is -#' specified by `legend.title` in [theme()] or theme. -#' @param title.hjust A number specifying horizontal justification of the -#' title text. -#' @param title.vjust A number specifying vertical justification of the title -#' text. -#' @param label logical. If `TRUE` then the labels are drawn. If -#' `FALSE` then the labels are invisible. -#' @param label.position A character string indicating the position of a -#' label. One of "top", "bottom" (default for horizontal guide), "left", or -#' "right" (default for vertical guide). -#' @param label.theme A theme object for rendering the label text. Usually the -#' object of [element_text()] is expected. By default, the theme is -#' specified by `legend.text` in [theme()]. -#' @param label.hjust A numeric specifying horizontal justification of the -#' label text. The default for standard text is 0 (left-aligned) and 1 -#' (right-aligned) for expressions. -#' @param label.vjust A numeric specifying vertical justification of the label -#' text. -#' @param keywidth,keyheight A numeric or [grid::unit()] object specifying the -#' width and height of the legend key respectively. Default value is -#' `legend.key.width`, `legend.key.height` or `legend.key` in [theme()].\cr -#' `r lifecycle::badge("experimental")`: optionally a `"null"` unit to stretch -#' keys to the available space. -#' @param key.spacing,key.spacing.x,key.spacing.y A numeric or [grid::unit()] -#' object specifying the distance between key-label pairs in the horizontal -#' direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both -#' (`key.spacing`). +#' @param theme A [`theme`][theme()] object to style the guide individually or +#' differently from the plot's theme settings. The `theme` argument in the +#' guide overrides, and is combined with, the plot's theme. #' @param position A character string indicating where the legend should be #' placed relative to the plot panels. #' @param direction A character string indicating the direction of the guide. #' One of "horizontal" or "vertical." -#' @param default.unit A character string indicating [grid::unit()] -#' for `keywidth` and `keyheight`. #' @param override.aes A list specifying aesthetic parameters of legend key. #' See details and examples. -#' @param nrow The desired number of rows of legends. -#' @param ncol The desired number of column of legends. -#' @param byrow logical. If `FALSE` (the default) the legend-matrix is -#' filled by columns, otherwise the legend-matrix is filled by rows. +#' @param nrow,ncol The desired number of rows and column of legends +#' respectively. #' @param reverse logical. If `TRUE` the order of legends is reversed. #' @param order positive integer less than 99 that specifies the order of #' this guide among multiple guides. This controls the order in which @@ -79,36 +46,32 @@ #' # Control styles #' #' # title position -#' p1 + guides(fill = guide_legend(title = "LEFT", title.position = "left")) +#' p1 + guides(fill = guide_legend( +#' title = "LEFT", theme(legend.title.position = "left") +#' )) #' #' # title text styles via element_text -#' p1 + guides(fill = -#' guide_legend( -#' title.theme = element_text( -#' size = 15, -#' face = "italic", -#' colour = "red", -#' angle = 0 -#' ) -#' ) -#' ) +#' p1 + guides(fill = guide_legend(theme = theme( +#' legend.title = element_text(size = 15, face = "italic", colour = "red") +#' ))) #' #' # label position -#' p1 + guides(fill = guide_legend(label.position = "left", label.hjust = 1)) +#' p1 + guides(fill = guide_legend(theme = theme( +#' legend.text.position = "left", +#' legend.text = element_text(hjust = 1) +#' ))) #' #' # label styles #' p1 + #' scale_fill_continuous( #' breaks = c(5, 10, 15), #' labels = paste("long", c(5, 10, 15)), -#' guide = guide_legend( -#' direction = "horizontal", -#' title.position = "top", -#' label.position = "bottom", -#' label.hjust = 0.5, -#' label.vjust = 1, -#' label.theme = element_text(angle = 90) -#' ) +#' guide = guide_legend(theme = theme( +#' legend.direction = "horizontal", +#' legend.title.position = "top", +#' legend.text.position = "bottom", +#' legend.text = element_text(hjust = 0.5, vjust = 1, angle = 90) +#' )) #' ) #' #' # Set aesthetic of legend key @@ -125,70 +88,31 @@ #' geom_point(aes(colour = color)) #' p + guides(col = guide_legend(nrow = 8)) #' p + guides(col = guide_legend(ncol = 8)) -#' p + guides(col = guide_legend(nrow = 8, byrow = TRUE)) +#' p + guides(col = guide_legend(nrow = 8, theme = theme(legend.byrow = TRUE))) #' #' # reversed order legend #' p + guides(col = guide_legend(reverse = TRUE)) #' } guide_legend <- function( # Title - title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - - # Label - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, + title = waiver(), - # Key size - keywidth = NULL, - keyheight = NULL, - key.spacing = NULL, - key.spacing.x = NULL, - key.spacing.y = NULL, + # Theme + theme = NULL, # General position = NULL, direction = NULL, - default.unit = "line", override.aes = list(), nrow = NULL, ncol = NULL, - byrow = FALSE, reverse = FALSE, order = 0, ... ) { - # Resolve key sizes - if (!(is.null(keywidth) || is.unit(keywidth))) { - keywidth <- unit(keywidth, default.unit) - } - if (!(is.null(keyheight) || is.unit(keyheight))) { - keyheight <- unit(keyheight, default.unit) - } - # Resolve spacing - key.spacing.x <- key.spacing.x %||% key.spacing - if (!is.null(key.spacing.x) || is.unit(key.spacing.x)) { - key.spacing.x <- unit(key.spacing.x, default.unit) - } - key.spacing.y <- key.spacing.y %||% key.spacing - if (!is.null(key.spacing.y) || is.unit(key.spacing.y)) { - key.spacing.y <- unit(key.spacing.y, default.unit) - } + theme <- deprecated_guide_args(theme, ...) - - if (!is.null(title.position)) { - title.position <- arg_match0(title.position, .trbl) - } - if (!is.null(label.position)) { - label.position <- arg_match0(label.position, .trbl) - } if (!is.null(position)) { position <- arg_match0(position, c(.trbl, "inside")) } @@ -196,30 +120,13 @@ guide_legend <- function( new_guide( # Title title = title, - title.position = title.position, - title.theme = title.theme, - title.hjust = title.hjust, - title.vjust = title.vjust, - - # Label - label = label, - label.position = label.position, - label.theme = label.theme, - label.hjust = label.hjust, - label.vjust = label.vjust, - - # Key size - keywidth = keywidth, - keyheight = keyheight, - key.spacing.x = key.spacing.x, - key.spacing.y = key.spacing.y, + theme = theme, # General direction = direction, override.aes = rename_aes(override.aes), nrow = nrow, ncol = ncol, - byrow = byrow, reverse = reverse, order = order, position = position, @@ -240,27 +147,12 @@ GuideLegend <- ggproto( params = list( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - - keywidth = NULL, - keyheight = NULL, - key.spacing.x = NULL, - key.spacing.y = NULL, + theme = NULL, # General override.aes = list(), nrow = NULL, ncol = NULL, - byrow = FALSE, reverse = FALSE, order = 0, @@ -275,20 +167,23 @@ GuideLegend <- ggproto( hashables = exprs(title, key$.label, name), elements = list( - background = "legend.background", - margin = "legend.margin", - key = "legend.key", - key.height = "legend.key.height", - key.width = "legend.key.width", - text = "legend.text", - theme.title = "legend.title" + background = "legend.background", + margin = "legend.margin", + key = "legend.key", + key_height = "legend.key.height", + key_width = "legend.key.width", + text = "legend.text", + theme.title = "legend.title", + spacing_x = "legend.key.spacing.x", + spacing_y = "legend.key.spacing.y", + text_position = "legend.text.position", + title_position = "legend.title.position", + byrow = "legend.byrow" ), extract_params = function(scale, params, title = waiver(), ...) { - params$title <- scale$make_title( - params$title %|W|% scale$name %|W|% title - ) + params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title) if (isTRUE(params$reverse %||% FALSE)) { params$key <- params$key[nrow(params$key):1, , drop = FALSE] } @@ -374,25 +269,9 @@ GuideLegend <- ggproto( setup_params = function(params) { params$direction <- arg_match0( - params$direction %||% direction, + params$direction, c("horizontal", "vertical"), arg_nm = "direction" ) - - if ("title.position" %in% names(params)) { - params$title.position <- arg_match0( - params$title.position %||% - switch(params$direction, vertical = "top", horizontal = "left"), - .trbl, arg_nm = "title.position" - ) - } - if ("label.position" %in% names(params)) { - params$label.position <- arg_match0( - params$label.position %||% "right", - .trbl, arg_nm = "label.position" - ) - params$rejust_labels <- TRUE - } - params$n_breaks <- n_breaks <- nrow(params$key) params$n_key_layers <- length(params$decor) + 1 # +1 is key background @@ -416,91 +295,86 @@ GuideLegend <- ggproto( params }, - override_elements = function(params, elements, theme) { + setup_elements = function(params, elements, theme) { + theme <- add_theme(theme, params$theme) + params$theme <- NULL - # Title - title <- combine_elements(params$title.theme, elements$theme.title) - title$hjust <- params$title.hjust %||% title$hjust %||% 0 - title$vjust <- params$title.vjust %||% title$vjust %||% 0.5 - elements$title <- title - - # Labels - if (!is.null(elements$text)) { - label <- combine_elements(params$label.theme, elements$text) - if (!params$label || is.null(params$key$.label)) { - label <- element_blank() - } else { - hjust <- unname(label_hjust_defaults[params$label.position]) - vjust <- unname(label_vjust_defaults[params$label.position]) - # Expressions default to right-justified - if (hjust == 0 && any(is.expression(params$key$.label))) { - hjust <- 1 - } - # Breaking justification inheritance for intuition purposes. - if (is.null(params$label.theme$hjust) && - is.null(theme$legend.text$hjust)) { - label$hjust <- NULL - } - if (is.null(params$label.theme$vjust) && - is.null(theme$legend.text$vjust)) { - label$vjust <- NULL - } - label$hjust <- params$label.hjust %||% label$hjust %||% hjust - label$vjust <- params$label.vjust %||% label$vjust %||% vjust - } - elements$text <- label - } - - # Keys - if (any(c("key.width", "key.height") %in% names(elements))) { - elements$key.width <- width_cm( params$keywidth %||% elements$key.width) - elements$key.height <- height_cm(params$keyheight %||% elements$key.height) - } + # Resolve text positions + text_position <- theme$legend.text.position %||% "right" + title_position <- theme$legend.title.position %||% switch( + params$direction, + vertical = "top", horizontal = "left" + ) + theme$legend.text.position <- + arg_match0(text_position, .trbl, arg_nm = "legend.text.position") + theme$legend.title.position <- + arg_match0(title_position, .trbl, arg_nm = "legend.title.position") - # Spacing - gap <- title$size %||% elements$theme.title$size %||% - elements$text$size %||% 11 - gap <- unit(gap * 0.5, "pt") - # Should maybe be elements$spacing.{x/y} instead of the theme's spacing? + # Set default spacing + theme$legend.key.spacing <- theme$legend.key.spacing %||% unit(5.5, "pt") + gap <- calc_element("legend.key.spacing", theme) + # For backward compatibility, default vertical spacing is no spacing if (params$direction == "vertical") { - # For backward compatibility, vertical default is no spacing - vgap <- params$key.spacing.y %||% unit(0, "pt") - } else { - vgap <- params$key.spacing.y %||% gap + theme$legend.key.spacing.y <- theme$legend.key.spacing.y %||% + unit(0, "pt") } - elements$hgap <- width_cm( params$key.spacing.x %||% gap) - elements$vgap <- height_cm(vgap) - elements$padding <- convertUnit( - elements$margin %||% margin(), - "cm", valueOnly = TRUE + # Resolve title. The trick here is to override the main text element, so + # that any settings declared in `legend.title` will be honoured but we have + # custom defaults for the guide. + margin <- calc_element("text", theme)$margin + title <- theme(text = element_text( + hjust = 0, vjust = 0.5, + margin = position_margin(title_position, margin, gap) + )) + elements$title <- calc_element("legend.title", add_theme(theme, title)) + + # Resolve text, setting default justification and margins. Again, the + # trick here is to set the main text element to propagate defaults while + # honouring the `legend.text` settings. + margin <- position_margin(text_position, margin, gap) + text <- theme( + text = switch( + text_position, + top = element_text(hjust = 0.5, vjust = 0.0, margin = margin), + bottom = element_text(hjust = 0.5, vjust = 1.0, margin = margin), + left = element_text(hjust = 1.0, vjust = 0.5, margin = margin), + right = element_text(hjust = 0.0, vjust = 0.5, margin = margin) + ) ) + elements$text <- calc_element("legend.text", add_theme(theme, text)) + Guide$setup_elements(params, elements, theme) + }, - # When no explicit margin has been set, either in this guide or in the - # theme, we set a default text margin to leave a small gap in between - # the label and the key. - if (is.null(params$label.theme$margin %||% theme$legend.text$margin) && - !inherits(elements$text, "element_blank")) { - i <- match(params$label.position, .trbl[c(3, 4, 1, 2)]) - elements$text$margin[i] <- elements$text$margin[i] + gap + override_elements = function(params, elements, theme) { + + if (any(c("key_width", "key_height") %in% names(elements))) { + # Determine if the key is stretched + elements$stretch_x <- unitType(elements$key_width) == "null" + elements$stretch_y <- unitType(elements$key_height) == "null" + # Convert key sizes to cm + elements$width_cm <- width_cm(elements$key_width) + elements$height_cm <- height_cm(elements$key_height) } - if (is.null(params$title.theme$margin %||% theme$legend.title$margin) && - !inherits(elements$title, "element_blank")) { - i <- match(params$title.position, .trbl[c(3, 4, 1, 2)]) - elements$title$margin[i] <- elements$title$margin[i] + gap + + # Convert padding and spacing to cm + if (any(c("spacing_x", "spacing_y") %in% names(elements))) { + elements$spacing_x <- width_cm(elements$spacing_x) + elements$spacing_y <- height_cm(elements$spacing_y) } + elements$padding <- + convertUnit(elements$margin %||% margin(), "cm", valueOnly = TRUE) + # Evaluate backgrounds early if (!is.null(elements$background)) { - elements$background <- ggname( - "legend.background", element_grob(elements$background) - ) + elements$background <- + ggname("legend.background", element_grob(elements$background)) } if (!is.null(elements$key)) { - elements$key <- ggname( - "legend.key", element_grob(elements$key) - ) + elements$key <- + ggname("legend.key", element_grob(elements$key)) } elements @@ -512,7 +386,7 @@ GuideLegend <- ggproto( build_decor = function(decor, grobs, elements, params) { - key_size <- c(elements$key.width, elements$key.height) * 10 + key_size <- c(elements$width_cm, elements$height_cm) * 10 draw <- function(i) { bg <- elements$key @@ -550,16 +424,17 @@ GuideLegend <- ggproto( }, measure_grobs = function(grobs, params, elements) { - byrow <- params$byrow %||% FALSE + + byrow <- elements$byrow %||% FALSE n_breaks <- params$n_breaks %||% 1L - dim <- c(params$nrow %||% 1L, params$ncol %||% 1L) + dim <- c(params$nrow %||% 1L, params$ncol %||% 1L) # A guide may have already specified the size of the decoration, only # measure when it hasn't already. sizes <- params$sizes %||% measure_legend_keys( grobs$decor, n = n_breaks, dim = dim, byrow = byrow, - default_width = elements$key.width, - default_height = elements$key.height + default_width = elements$width_cm, + default_height = elements$height_cm ) widths <- sizes$widths heights <- sizes$heights @@ -578,18 +453,18 @@ GuideLegend <- ggproto( # Interleave gaps between keys and labels, which depends on the label # position. For unclear reasons, we need to adjust some gaps based on the # `byrow` parameter (see also #4352). - hgap <- elements$hgap %||% 0 + hgap <- elements$spacing_x %||% 0 widths <- switch( - params$label.position, + elements$text_position, "left" = list(label_widths, widths, hgap), "right" = list(widths, label_widths, hgap), list(pmax(label_widths, widths), hgap) ) widths <- head(vec_interleave(!!!widths), -1) - vgap <- elements$vgap %||% 0 + vgap <- elements$spacing_y %||% 0 heights <- switch( - params$label.position, + elements$text_position, "top" = list(label_heights, heights, vgap), "bottom" = list(heights, label_heights, vgap), list(pmax(label_heights, heights), vgap) @@ -604,33 +479,25 @@ GuideLegend <- ggproto( title_height <- height_cm(grobs$title) # Titles are assumed to have sufficient size when keys are null units - if (is.unit(params$keywidth) && unitType(params$keywidth) == "null") { - extra_width <- 0 - } else { - extra_width <- max(0, title_width - sum(widths)) - } - if (is.unit(params$keyheight) && unitType(params$keyheight) == "null") { - extra_height <- 0 - } else { - extra_height <- max(0, title_height - sum(heights)) - } + extra_width <- + if (isTRUE(elements$stretch_x)) 0 else max(0, title_width - sum(widths)) + extra_height <- + if (isTRUE(elements$stretch_y)) 0 else max(0, title_height - sum(heights)) - just <- with(elements$title, rotate_just(angle, hjust, vjust)) - hjust <- just$hjust - vjust <- just$vjust + just <- with(elements$title, rotate_just(angle, hjust, vjust)) # Combine title with rest of the sizes based on its position widths <- switch( - params$title.position, + elements$title_position, "left" = c(title_width, widths), "right" = c(widths, title_width), - c(extra_width * hjust, widths, extra_width * (1 - hjust)) + c(extra_width * just$hjust, widths, extra_width * (1 - just$hjust)) ) heights <- switch( - params$title.position, + elements$title_position, "top" = c(title_height, heights), "bottom" = c(heights, title_height), - c(extra_height * (1 - vjust), heights, extra_height * vjust) + c(extra_height * (1 - just$vjust), heights, extra_height * just$vjust) ) } @@ -638,7 +505,9 @@ GuideLegend <- ggproto( widths = widths, heights = heights, padding = elements$padding, - has_title = has_title + has_title = has_title, + label_position = elements$text_position, + title_position = elements$title_position ) }, @@ -649,43 +518,43 @@ GuideLegend <- ggproto( # Find rows / columns of legend items if (params$byrow %||% FALSE) { - df <- data_frame0( - R = ceiling(break_seq / dim[2]), - C = (break_seq - 1) %% dim[2] + 1 - ) + row <- ceiling(break_seq / dim[2L]) + col <- (break_seq - 1L) %% dim[2L] + 1L } else { df <- mat_2_df(arrayInd(break_seq, dim), c("R", "C")) + row <- df$R + col <- df$C } # Make spacing for padding / gaps. For example: because first gtable cell # will be padding, first item will be at [2, 2] position. Then the # second item-row will be [4, 2] because [3, 2] will be a gap cell. - key_row <- label_row <- df$R * 2 - key_col <- label_col <- df$C * 2 + key_row <- label_row <- row * 2 + key_col <- label_col <- col * 2 # Make gaps for key-label spacing depending on label position switch( - params$label.position, + sizes$label_position, "top" = { - key_row <- key_row + df$R + key_row <- key_row + row label_row <- key_row - 1 }, "bottom" = { - key_row <- key_row + df$R - 1 + key_row <- key_row + row - 1 label_row <- key_row + 1 }, "left" = { - key_col <- key_col + df$C + key_col <- key_col + col label_col <- key_col - 1 }, "right" = { - key_col <- key_col + df$C - 1 + key_col <- key_col + col - 1 label_col <- key_col + 1 } ) # Offset layout based on title position if (sizes$has_title) { - position <- params$title.position + position <- sizes$title_position if (position != "right") { key_col <- key_col + 1 label_col <- label_col + 1 @@ -710,15 +579,13 @@ GuideLegend <- ggproto( assemble_drawing = function(grobs, layout, sizes, params, elements) { widths <- unit(c(sizes$padding[4], sizes$widths, sizes$padding[2]), "cm") - if (is.unit(params$keywidth) && unitType(params$keywidth) == "null") { - i <- unique(layout$layout$key_col) - widths[i] <- params$keywidth + if (isTRUE(elements$stretch_x)) { + widths[unique(layout$layout$key_col)] <- elements$key_width } heights <- unit(c(sizes$padding[1], sizes$heights, sizes$padding[3]), "cm") - if (is.unit(params$keyheight) && unitType(params$keyheight) == "null") { - i <- unique(layout$layout$key_row) - heights[i] <- params$keyheight + if (isTRUE(elements$stretch_y)) { + heights[unique(layout$layout$key_row)] <- elements$key_height } gt <- gtable(widths = widths, heights = heights) @@ -735,14 +602,7 @@ GuideLegend <- ggproto( # Add title if (!is.zero(grobs$title)) { gt <- gtable_add_grob( - gt, - justify_grobs( - grobs$title, - hjust = elements$title$hjust, - vjust = elements$title$vjust, - int_angle = elements$title$angle, - debug = elements$title$debug - ), + gt, grobs$title, name = "title", clip = "off", t = min(layout$title_row), r = max(layout$title_col), b = max(layout$title_row), l = min(layout$title_col) @@ -770,18 +630,8 @@ GuideLegend <- ggproto( } if (!is.zero(grobs$labels)) { - labels <- if (params$rejust_labels %||% TRUE) { - justify_grobs( - grobs$labels, - hjust = elements$text$hjust, vjust = elements$text$vjust, - int_angle = elements$text$angle, debug = elements$text$debug - ) - } else { - grobs$labels - } - gt <- gtable_add_grob( - gt, labels, + gt, grobs$labels, name = names(labels) %||% paste("label", layout$label_row, layout$label_col, sep = "-"), clip = "off", @@ -794,8 +644,6 @@ GuideLegend <- ggproto( } ) -label_hjust_defaults <- c(top = 0.5, bottom = 0.5, left = 1, right = 0) -label_vjust_defaults <- c(top = 0, bottom = 1, left = 0.5, right = 0.5) measure_legend_keys <- function(keys, n, dim, byrow = FALSE, default_width = 1, default_height = 1) { @@ -880,3 +728,129 @@ keep_key_data <- function(key, data, aes, show) { } keep } + +position_margin <- function(position, margin = margin(), gap = unit(0, "pt")) { + switch( + position, + top = replace(margin, 3, margin[3] + gap), + bottom = replace(margin, 1, margin[1] + gap), + left = replace(margin, 2, margin[2] + gap), + right = replace(margin, 4, margin[4] + gap) + ) +} + +# Function implementing backward compatibility with the old way of specifying +# guide styling +deprecated_guide_args <- function( + theme = NULL, + title.position = NULL, + title.theme = NULL, title.hjust = NULL, title.vjust = NULL, + label = NULL, + label.position = NULL, + label.theme = NULL, label.hjust = NULL, label.vjust = NULL, + keywidth = NULL, keyheight = NULL, barwidth = NULL, barheight = NULL, + byrow = NULL, + frame.colour = NULL, frame.linewidth = NULL, frame.linetype = NULL, + ticks = NULL, ticks.colour = NULL, ticks.linewidth = NULL, + axis = NULL, axis.colour = NULL, axis.linewidth = NULL, axis.arrow = NULL, + default.unit = "line", + ..., + .call = caller_call()) { + + args <- names(formals(deprecated_guide_args)) + args <- setdiff(args, c("theme", "default.unit", "...", ".call")) + vals <- compact(mget(args, current_env())) + + # Early exit when no old arguments have been supplied + if (length(vals) == 0) { + return(theme) + } + fun_name <- call_name(.call) + replacement <- paste0(fun_name, "(theme)") + for (arg_name in names(vals)) { + deprecate_soft0( + when = "3.5.0", + what = paste0(fun_name, "(", arg_name, ")"), + with = replacement + ) + } + def_unit <- function(x) { + if (is.null(x) || is.unit(x)) { + return(x) + } + unit(x, default.unit) + } + + theme <- theme %||% list() + + # Resolve straightforward arguments + theme <- replace_null( + theme, + legend.title.position = title.position, + legend.text.position = label.position, + legend.byrow = byrow, + legend.key.width = def_unit(keywidth %||% barwidth), + legend.key.height = def_unit(keyheight %||% barheight) + ) + + # Set legend.text + if (isFALSE(label)) { + label.theme <- element_blank() + } else if (!is.null(label.theme %||% label.hjust %||% label.vjust)) { + label.theme <- label.theme %||% element_text() + label.theme <- replace_null( + label.theme, + hjust = label.hjust %||% label.theme$hjust, + vjust = label.vjust %||% label.theme$vjust + ) + } + theme$legend.text <- theme$legend.text %||% label.theme + + # Set legend.title + if (!is.null(title.hjust %||% title.vjust)) { + title.theme <- title.theme %||% element_text() + title.theme <- replace_null( + title.theme, + hjust = title.hjust %||% title.theme$hjust, + vjust = title.vjust %||% title.theme$vjust + ) + } + theme$legend.title <- theme$legend.title %||% title.theme + + # Set legend.frame + if (!is.null(frame.colour %||% frame.linewidth %||% frame.linetype)) { + frame <- theme$legend.frame %||% element_rect( + colour = frame.colour, + linewidth = frame.linewidth, + linetype = frame.linetype + ) + theme$legend.frame <- theme$legend.frame %||% frame + } + + # Set legend.ticks + if (isFALSE(ticks)) { + ticks <- element_blank() + } else if (!is.null(ticks.colour %||% ticks.linewidth)) { + ticks <- element_line(colour = ticks.colour, linewidth = ticks.linewidth) + theme$legend.ticks <- theme$legend.ticks %||% ticks + } + + # Set legend.axis + if (isFALSE(axis)) { + axis <- element_blank() + } else if (!is.null(axis.colour %||% axis.linewidth %||% axis.arrow)) { + axis <- element_line( + colour = axis.colour, + linewidth = axis.linewidth, + arrow = axis.arrow + ) + theme$legend.axis.line <- theme$legend.axis.line %||% axis + } + + # Set as theme + theme <- compact(theme) + if (!is.theme(theme)) { + theme <- inject(theme(!!!theme)) + } + theme +} diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 7a062409a0..e9436acfb9 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -176,6 +176,7 @@ theme_grey <- function(base_size = 11, base_family = "", legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, + legend.key.spacing = unit(half_line, "pt"), legend.text = element_text(size = rel(0.8)), legend.title = element_text(hjust = 0), legend.position = "right", @@ -474,6 +475,7 @@ theme_void <- function(base_size = 11, base_family = "", legend.position = "right", legend.text = element_text(size = rel(0.8)), legend.title = element_text(hjust = 0), + legend.key.spacing = unit(half_line, "pt"), strip.clip = "inherit", strip.text = element_text(size = rel(0.8)), strip.switch.pad.grid = unit(half_line / 2, "pt"), @@ -579,6 +581,9 @@ theme_test <- function(base_size = 11, base_family = "", legend.key.size = unit(1.2, "lines"), legend.key.height = NULL, legend.key.width = NULL, + legend.key.spacing = unit(half_line, "pt"), + legend.key.spacing.x = NULL, + legend.key.spacing.y = NULL, legend.text = element_text(size = rel(0.8)), legend.title = element_text(hjust = 0), legend.position = "right", diff --git a/R/theme-elements.R b/R/theme-elements.R index 448aa4763a..d90d11ae11 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -500,8 +500,18 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key = el_def("element_rect", "panel.background"), legend.key.height = el_def(c("unit", "rel"), "legend.key.size"), legend.key.width = el_def(c("unit", "rel"), "legend.key.size"), + legend.key.spacing = el_def("unit"), + legend.key.spacing.x = el_def(c("unit", "rel"), "legend.key.spacing"), + legend.key.spacing.y = el_def(c("unit", "rel"), "legend.key.spacing"), + legend.frame = el_def("element_rect", "rect"), + legend.axis.line = el_def("element_line", "line"), + legend.ticks = el_def("element_line", "legend.axis.line"), + legend.ticks.length = el_def("unit"), legend.text = el_def("element_text", "text"), + legend.text.position = el_def("character"), legend.title = el_def("element_text", "title"), + legend.title.position = el_def("character"), + legend.byrow = el_def("logical"), legend.position = el_def("character"), legend.position.inside = el_def(c("numeric", "integer")), legend.direction = el_def("character"), diff --git a/R/theme.R b/R/theme.R index 6def5d7ab5..1e012d13ad 100644 --- a/R/theme.R +++ b/R/theme.R @@ -74,16 +74,31 @@ #' @param legend.key.size,legend.key.height,legend.key.width #' size of legend keys (`unit`); key background height & width inherit from #' `legend.key.size` or can be specified separately +#' @param legend.key.spacing,legend.key.spacing.x,legend.key.spacing.y spacing +#' between legend keys given as a `unit`. Spacing in the horizontal (x) and +#' vertical (y) direction inherit from `legend.key.spacing` or can be +#' specified separately. +#' @param legend.frame frame drawn around the bar ([element_rect()]). +#' @param legend.ticks tick marks shown along bars or axes ([element_line()]) +#' @param legend.ticks.length length of tick marks in legend (`unit`) +#' @param legend.axis.line lines along axes in legends ([element_line()]) #' @param legend.text legend item labels ([element_text()]; inherits from #' `text`) +#' @param legend.text.position placement of legend text relative to legend keys +#' or bars ("top", "right", "bottom" or "left"). The legend text placement +#' might be incompatible with the legend's direction for some guides. #' @param legend.title title of legend ([element_text()]; inherits from #' `title`) +#' @param legend.title.position placement of legend title relative to the main +#' legend ("top", "right", "bottom" or "left"). #' @param legend.position the default position of legends ("none", "left", #' "right", "bottom", "top", "inside") #' @param legend.position.inside A numeric vector of length two setting the #' placement of legends that have the `"inside"` position. #' @param legend.direction layout of items in legends ("horizontal" or #' "vertical") +#' @param legend.byrow whether the legend-matrix is filled by columns +#' (`FALSE`, the default) or by rows (`TRUE`). #' @param legend.justification anchor point for positioning legend inside plot #' ("center" or two-element numeric vector) or the justification according to #' the plot area when positioned outside the plot @@ -349,11 +364,21 @@ theme <- function(..., legend.key.size, legend.key.height, legend.key.width, + legend.key.spacing, + legend.key.spacing.x, + legend.key.spacing.y, + legend.frame, + legend.ticks, + legend.ticks.length, + legend.axis.line, legend.text, + legend.text.position, legend.title, + legend.title.position, legend.position, legend.position.inside, legend.direction, + legend.byrow, legend.justification, legend.justification.top, legend.justification.bottom, @@ -501,10 +526,17 @@ is_theme_complete <- function(x) isTRUE(attr(x, "complete", exact = TRUE)) # check whether theme should be validated is_theme_validate <- function(x) { validate <- attr(x, "validate", exact = TRUE) - if (is.null(validate)) - TRUE # we validate by default - else - isTRUE(validate) + isTRUE(validate %||% TRUE) +} + +validate_theme <- function(theme, tree = get_element_tree()) { + if (!is_theme_validate(theme)) { + return() + } + mapply( + validate_element, theme, names(theme), + MoreArgs = list(element_tree = tree) + ) } # Combine plot defaults with current theme to get complete theme for a plot @@ -527,12 +559,7 @@ plot_theme <- function(x, default = theme_get()) { theme[missing] <- ggplot_global$theme_default[missing] # Check that all elements have the correct class (element_text, unit, etc) - if (is_theme_validate(theme)) { - mapply( - validate_element, theme, names(theme), - MoreArgs = list(element_tree = get_element_tree()) - ) - } + validate_theme(theme) theme } diff --git a/R/utilities.R b/R/utilities.R index 5888423cea..127765dafb 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -773,6 +773,25 @@ vec_rbind0 <- function(..., .error_call = current_env(), .call = caller_env()) { ) } +# This function is used to vectorise the following pattern: +# +# obj$name1 <- obj$name1 %||% value +# obj$name2 <- obj$name2 %||% value +# +# and express this pattern as: +# +# replace_null(obj, name1 = value, name2 = value) +replace_null <- function(obj, ..., env = caller_env()) { + # Collect dots without evaluating + dots <- enexprs(...) + # Select arguments that are null in `obj` + nms <- names(dots) + nms <- nms[vapply(obj[nms], is.null, logical(1))] + # Replace those with the evaluated dots + obj[nms] <- inject(list(!!!dots[nms]), env = env) + obj +} + attach_plot_env <- function(env) { old_env <- getOption("ggplot2_plot_env") options(ggplot2_plot_env = env) diff --git a/man/element.Rd b/man/element.Rd index 3102d9a7d4..a3c27a259c 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -1,16 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/margins.R, R/theme-elements.R -\name{margin} -\alias{margin} +% Please edit documentation in R/theme-elements.R, R/margins.R +\name{element} \alias{element_blank} \alias{element_rect} \alias{element_line} \alias{element_text} \alias{rel} +\alias{margin} \title{Theme elements} \usage{ -margin(t = 0, r = 0, b = 0, l = 0, unit = "pt") - element_blank() element_rect( @@ -50,13 +48,10 @@ element_text( ) rel(x) + +margin(t = 0, r = 0, b = 0, l = 0, unit = "pt") } \arguments{ -\item{t, r, b, l}{Dimensions of each margin. (To remember order, think trouble).} - -\item{unit}{Default units of dimensions. Defaults to "pt" so it -can be most easily scaled with the text.} - \item{fill}{Fill colour.} \item{colour, color}{Line/border colour. Color is an alias for colour.} @@ -101,6 +96,11 @@ rectangle behind the complete text area, and a point where each label is anchored.} \item{x}{A single number specifying size relative to parent element.} + +\item{t, r, b, l}{Dimensions of each margin. (To remember order, think trouble).} + +\item{unit}{Default units of dimensions. Defaults to "pt" so it +can be most easily scaled with the text.} } \value{ An S3 object of class \code{element}, \code{rel}, or \code{margin}. diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index fa09421300..4d4ba4f166 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -6,6 +6,7 @@ \usage{ guide_axis( title = waiver(), + theme = NULL, check.overlap = FALSE, angle = waiver(), n.dodge = 1, @@ -21,6 +22,10 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} + \item{check.overlap}{silently remove overlapping labels, (recursively) prioritizing the first, last, and middle labels.} diff --git a/man/guide_axis_logticks.Rd b/man/guide_axis_logticks.Rd index 60ebaa8b12..3b8fcb5478 100644 --- a/man/guide_axis_logticks.Rd +++ b/man/guide_axis_logticks.Rd @@ -13,6 +13,7 @@ guide_axis_logticks( short_theme = element_line(), expanded = TRUE, cap = "none", + theme = NULL, ... ) } @@ -45,6 +46,10 @@ be \code{"none"} (default) to draw the axis line along the whole panel, or \code{"both"} to only draw the line in between the most extreme breaks. \code{TRUE} and \code{FALSE} are shorthand for \code{"both"} and \code{"none"} respectively.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} + \item{...}{ Arguments passed on to \code{\link[=guide_axis]{guide_axis}} \describe{ diff --git a/man/guide_axis_stack.Rd b/man/guide_axis_stack.Rd index 63ae75b003..a001a35ac2 100644 --- a/man/guide_axis_stack.Rd +++ b/man/guide_axis_stack.Rd @@ -8,6 +8,7 @@ guide_axis_stack( first = "axis", ..., title = waiver(), + theme = NULL, spacing = NULL, order = 0, position = waiver() @@ -27,6 +28,10 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} + \item{spacing}{A \code{\link[=unit]{unit()}} objects that determines how far separate guides are spaced apart.} diff --git a/man/guide_axis_theta.Rd b/man/guide_axis_theta.Rd index 16a8e89cf1..6e18e57a60 100644 --- a/man/guide_axis_theta.Rd +++ b/man/guide_axis_theta.Rd @@ -6,6 +6,7 @@ \usage{ guide_axis_theta( title = waiver(), + theme = NULL, angle = waiver(), minor.ticks = FALSE, cap = "none", @@ -19,6 +20,10 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} + \item{angle}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}}, this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that you probably want. Can be one of the following: diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 59faaa8050..8633915f2d 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -6,26 +6,9 @@ \usage{ guide_bins( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - keywidth = NULL, - keyheight = NULL, - axis = TRUE, - axis.colour = "black", - axis.linewidth = NULL, - axis.arrow = NULL, - ticks = NULL, - ticks.length = unit(0.2, "npc"), + theme = NULL, position = NULL, direction = NULL, - default.unit = "line", override.aes = list(), reverse = FALSE, order = 0, @@ -39,63 +22,9 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} -\item{title.position}{A character string indicating the position of a -title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - -\item{title.theme}{A theme object for rendering the title text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} - -\item{title.hjust}{A number specifying horizontal justification of the -title text.} - -\item{title.vjust}{A number specifying vertical justification of the title -text.} - -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - -\item{label.position}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} - -\item{label.hjust}{A numeric specifying horizontal justification of the -label text. The default for standard text is 0 (left-aligned) and 1 -(right-aligned) for expressions.} - -\item{label.vjust}{A numeric specifying vertical justification of the label -text.} - -\item{keywidth, keyheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the -width and height of the legend key respectively. Default value is -\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch -keys to the available space.} - -\item{axis}{A theme object for rendering a small axis along the guide. -Usually, the object of \code{element_line()} is expected (default). If -\code{element_blank()}, no axis is drawn. For backward compatibility, can also -be a logical which translates \code{TRUE} to \code{element_line()} and \code{FALSE} to -\code{element_blank()}.} - -\item{axis.colour, axis.linewidth}{Graphic specifications for the look of the -axis.} - -\item{axis.arrow}{A call to \code{arrow()} to specify arrows at the end of the -axis line, thus showing an open interval.} - -\item{ticks}{A theme object for rendering tick marks at the colourbar. -Usually, the object of \code{element_line()} is expected. If \code{element_blank()}, -no tick marks are drawn. If \code{NULL} (default), the \code{axis} argument is -re-used as \code{ticks} argument (without arrow).} - -\item{ticks.length}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the -length of tick marks between the keys.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} \item{position}{A character string indicating where the legend should be placed relative to the plot panels.} @@ -103,9 +32,6 @@ placed relative to the plot panels.} \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} -\item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} -for \code{keywidth} and \code{keyheight}.} - \item{override.aes}{A list specifying aesthetic parameters of legend key. See details and examples.} @@ -158,12 +84,15 @@ p <- ggplot(mtcars) + p # Remove the axis or style it -p + guides(size = guide_bins(axis = FALSE)) +p + guides(size = guide_bins( + theme = theme(legend.axis.line = element_blank()) +)) p + guides(size = guide_bins(show.limits = TRUE)) +my_arrow <- arrow(length = unit(1.5, "mm"), ends = "both") p + guides(size = guide_bins( - axis.arrow = arrow(length = unit(1.5, 'mm'), ends = 'both') + theme = theme(legend.axis.line = element_line(arrow = my_arrow)) )) # Guides are merged together if possible diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 045396216e..2078bc13db 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -7,32 +7,13 @@ \usage{ guide_colourbar( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - barwidth = NULL, - barheight = NULL, + theme = NULL, nbin = 300, raster = TRUE, - frame = element_blank(), - frame.colour = NULL, - frame.linewidth = NULL, - frame.linetype = NULL, - ticks = element_line(), - ticks.colour = NULL, - ticks.linewidth = NULL, - ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, position = NULL, direction = NULL, - default.unit = "line", reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), @@ -41,32 +22,13 @@ guide_colourbar( guide_colorbar( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - barwidth = NULL, - barheight = NULL, + theme = NULL, nbin = 300, raster = TRUE, - frame = element_blank(), - frame.colour = NULL, - frame.linewidth = NULL, - frame.linetype = NULL, - ticks = element_line(), - ticks.colour = NULL, - ticks.linewidth = NULL, - ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, position = NULL, direction = NULL, - default.unit = "line", reverse = FALSE, order = 0, available_aes = c("colour", "color", "fill"), @@ -79,43 +41,9 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} -\item{title.position}{A character string indicating the position of a -title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - -\item{title.theme}{A theme object for rendering the title text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} - -\item{title.hjust}{A number specifying horizontal justification of the -title text.} - -\item{title.vjust}{A number specifying vertical justification of the title -text.} - -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - -\item{label.position}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} - -\item{label.hjust}{A numeric specifying horizontal justification of the -label text. The default for standard text is 0 (left-aligned) and 1 -(right-aligned) for expressions.} - -\item{label.vjust}{A numeric specifying vertical justification of the label -text.} - -\item{barwidth, barheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the -width and height of the bar respectively. Default value is derived from -\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch -the bar to the available space.} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} \item{nbin}{A numeric specifying the number of bins for drawing the colourbar. A smoother colourbar results from a larger value.} @@ -125,34 +53,6 @@ raster object. If \code{FALSE} then the colourbar is rendered as a set of rectangles. Note that not all graphics devices are capable of rendering raster image.} -\item{frame}{A theme object for rendering a frame drawn around the bar. -Usually, the object of \code{element_rect()} is expected. If \code{element_blank()} -(default), no frame is drawn.} - -\item{frame.colour}{A string specifying the colour of the frame -drawn around the bar. For backward compatibility, if this argument is -not \code{NULL}, the \code{frame} argument will be set to \code{element_rect()}.} - -\item{frame.linewidth}{A numeric specifying the width of the frame -drawn around the bar in millimetres.} - -\item{frame.linetype}{A numeric specifying the linetype of the frame -drawn around the bar.} - -\item{ticks}{A theme object for rendering tick marks at the colourbar. -Usually, the object of \code{element_line()} is expected (default). If -\code{element_blank()}, no tick marks are drawn. For backward compatibility, -can also be a logical which translates \code{TRUE} to \code{element_line()} and -\code{FALSE} to \code{element_blank()}.} - -\item{ticks.colour}{A string specifying the colour of the tick marks.} - -\item{ticks.linewidth}{A numeric specifying the width of the tick marks in -millimetres.} - -\item{ticks.length}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the -length of tick marks at the colourbar.} - \item{draw.ulim}{A logical specifying if the upper limit tick marks should be visible.} @@ -165,9 +65,6 @@ placed relative to the plot panels.} \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} -\item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} -for \code{barwidth} and \code{barheight}.} - \item{reverse}{logical. If \code{TRUE} the colourbar is reversed. By default, the highest value is on the top and the lowest value is on the bottom} @@ -212,19 +109,31 @@ p1 + guides(fill = guide_colourbar()) # Control styles # bar size -p1 + guides(fill = guide_colourbar(barwidth = 0.5, barheight = 10)) +p1 + guides(fill = guide_colourbar(theme = theme( + legend.key.width = unit(0.5, "lines"), + legend.key.height = unit(10, "lines") +))) + # no label -p1 + guides(fill = guide_colourbar(label = FALSE)) +p1 + guides(fill = guide_colourbar(theme = theme( + legend.text = element_blank() +))) # no tick marks -p1 + guides(fill = guide_colourbar(ticks = FALSE)) +p1 + guides(fill = guide_colourbar(theme = theme( + legend.ticks = element_blank() +))) # label position -p1 + guides(fill = guide_colourbar(label.position = "left")) +p1 + guides(fill = guide_colourbar(theme = theme( + legend.text.position = "left" +))) # label theme -p1 + guides(fill = guide_colourbar(label.theme = element_text(colour = "blue", angle = 0))) +p1 + guides(fill = guide_colourbar(theme = theme( + legend.text = element_text(colour = "blue", angle = 0) +))) # small number of bins p1 + guides(fill = guide_colourbar(nbin = 3)) @@ -237,7 +146,7 @@ p1 + scale_fill_continuous( limits = c(0,20), breaks = c(0, 5, 10, 15, 20), guide = guide_colourbar(nbin = 100, draw.ulim = FALSE, draw.llim = FALSE) - ) + ) # guides can be controlled independently p2 + @@ -246,8 +155,12 @@ p2 + p2 + guides(fill = "colourbar", size = "legend") p2 + - scale_fill_continuous(guide = guide_colourbar(direction = "horizontal")) + - scale_size(guide = guide_legend(direction = "vertical")) + scale_fill_continuous(guide = guide_colourbar(theme = theme( + legend.direction = "horizontal" + ))) + + scale_size(guide = guide_legend(theme = theme( + legend.direction = "vertical" + ))) } \seealso{ Other guides: diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index 4a8b42bdd9..3df628de34 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -6,20 +6,39 @@ \title{Discretized colourbar guide} \usage{ guide_coloursteps( + title = waiver(), + theme = NULL, even.steps = TRUE, show.limits = NULL, - ticks = element_blank(), + direction = NULL, + reverse = FALSE, + order = 0, + available_aes = c("colour", "color", "fill"), ... ) guide_colorsteps( + title = waiver(), + theme = NULL, even.steps = TRUE, show.limits = NULL, - ticks = element_blank(), + direction = NULL, + reverse = FALSE, + order = 0, + available_aes = c("colour", "color", "fill"), ... ) } \arguments{ +\item{title}{A character string or expression indicating a title of guide. +If \code{NULL}, the title is not shown. By default +(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name +specified in \code{\link[=labs]{labs()}} is used for the title.} + +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} + \item{even.steps}{Should the rendered size of the bins be equal, or should they be proportional to their length in the data space? Defaults to \code{TRUE}} @@ -29,79 +48,21 @@ scale. This argument is ignored if \code{labels} is given as a vector of values. If one or both of the limits is also given in \code{breaks} it will be shown irrespective of the value of \code{show.limits}.} -\item{ticks}{A theme object for rendering tick marks at the colourbar. -Usually, the object of \code{element_line()} is expected. If \code{element_blank()} -(default), no tick marks are drawn. For backward compatibility, can also -be a logical which translates \code{TRUE} to \code{element_line()} and \code{FALSE} to -\code{element_blank()}.} - -\item{...}{ - Arguments passed on to \code{\link[=guide_colourbar]{guide_colourbar}} - \describe{ - \item{\code{barwidth,barheight}}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the -width and height of the bar respectively. Default value is derived from -\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch -the bar to the available space.} - \item{\code{frame}}{A theme object for rendering a frame drawn around the bar. -Usually, the object of \code{element_rect()} is expected. If \code{element_blank()} -(default), no frame is drawn.} - \item{\code{frame.colour}}{A string specifying the colour of the frame -drawn around the bar. For backward compatibility, if this argument is -not \code{NULL}, the \code{frame} argument will be set to \code{element_rect()}.} - \item{\code{frame.linewidth}}{A numeric specifying the width of the frame -drawn around the bar in millimetres.} - \item{\code{frame.linetype}}{A numeric specifying the linetype of the frame -drawn around the bar.} - \item{\code{ticks.colour}}{A string specifying the colour of the tick marks.} - \item{\code{ticks.linewidth}}{A numeric specifying the width of the tick marks in -millimetres.} - \item{\code{ticks.length}}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the -length of tick marks at the colourbar.} - \item{\code{draw.ulim}}{A logical specifying if the upper limit tick marks should -be visible.} - \item{\code{draw.llim}}{A logical specifying if the lower limit tick marks should -be visible.} - \item{\code{direction}}{A character string indicating the direction of the guide. +\item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} - \item{\code{default.unit}}{A character string indicating \code{\link[grid:unit]{grid::unit()}} -for \code{barwidth} and \code{barheight}.} - \item{\code{reverse}}{logical. If \code{TRUE} the colourbar is reversed. By default, + +\item{reverse}{logical. If \code{TRUE} the colourbar is reversed. By default, the highest value is on the top and the lowest value is on the bottom} - \item{\code{title}}{A character string or expression indicating a title of guide. -If \code{NULL}, the title is not shown. By default -(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name -specified in \code{\link[=labs]{labs()}} is used for the title.} - \item{\code{title.position}}{A character string indicating the position of a -title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - \item{\code{title.theme}}{A theme object for rendering the title text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} - \item{\code{title.hjust}}{A number specifying horizontal justification of the -title text.} - \item{\code{title.vjust}}{A number specifying vertical justification of the title -text.} - \item{\code{label}}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - \item{\code{label.position}}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - \item{\code{label.theme}}{A theme object for rendering the label text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} - \item{\code{label.hjust}}{A numeric specifying horizontal justification of the -label text. The default for standard text is 0 (left-aligned) and 1 -(right-aligned) for expressions.} - \item{\code{label.vjust}}{A numeric specifying vertical justification of the label -text.} - \item{\code{position}}{A character string indicating where the legend should be -placed relative to the plot panels.} - \item{\code{order}}{positive integer less than 99 that specifies the order of + +\item{order}{positive integer less than 99 that specifies the order of this guide among multiple guides. This controls the order in which multiple guides are displayed, not the contents of the guide itself. If 0 (default), the order is determined by a secret algorithm.} - }} + +\item{available_aes}{A vector of character strings listing the aesthetics +for which a colourbar can be drawn.} + +\item{...}{ignored.} } \value{ A guide object diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index bfd498defc..952cc1d1d4 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -6,27 +6,12 @@ \usage{ guide_legend( title = waiver(), - title.position = NULL, - title.theme = NULL, - title.hjust = NULL, - title.vjust = NULL, - label = TRUE, - label.position = NULL, - label.theme = NULL, - label.hjust = NULL, - label.vjust = NULL, - keywidth = NULL, - keyheight = NULL, - key.spacing = NULL, - key.spacing.x = NULL, - key.spacing.y = NULL, + theme = NULL, position = NULL, direction = NULL, - default.unit = "line", override.aes = list(), nrow = NULL, ncol = NULL, - byrow = FALSE, reverse = FALSE, order = 0, ... @@ -38,48 +23,9 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} -\item{title.position}{A character string indicating the position of a -title. One of "top" (default for a vertical guide), "bottom", "left" -(default for a horizontal guide), or "right."} - -\item{title.theme}{A theme object for rendering the title text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.title} in \code{\link[=theme]{theme()}} or theme.} - -\item{title.hjust}{A number specifying horizontal justification of the -title text.} - -\item{title.vjust}{A number specifying vertical justification of the title -text.} - -\item{label}{logical. If \code{TRUE} then the labels are drawn. If -\code{FALSE} then the labels are invisible.} - -\item{label.position}{A character string indicating the position of a -label. One of "top", "bottom" (default for horizontal guide), "left", or -"right" (default for vertical guide).} - -\item{label.theme}{A theme object for rendering the label text. Usually the -object of \code{\link[=element_text]{element_text()}} is expected. By default, the theme is -specified by \code{legend.text} in \code{\link[=theme]{theme()}}.} - -\item{label.hjust}{A numeric specifying horizontal justification of the -label text. The default for standard text is 0 (left-aligned) and 1 -(right-aligned) for expressions.} - -\item{label.vjust}{A numeric specifying vertical justification of the label -text.} - -\item{keywidth, keyheight}{A numeric or \code{\link[grid:unit]{grid::unit()}} object specifying the -width and height of the legend key respectively. Default value is -\code{legend.key.width}, \code{legend.key.height} or \code{legend.key} in \code{\link[=theme]{theme()}}.\cr -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}: optionally a \code{"null"} unit to stretch -keys to the available space.} - -\item{key.spacing, key.spacing.x, key.spacing.y}{A numeric or \code{\link[grid:unit]{grid::unit()}} -object specifying the distance between key-label pairs in the horizontal -direction (\code{key.spacing.x}), vertical direction (\code{key.spacing.y}) or both -(\code{key.spacing}).} +\item{theme}{A \code{\link[=theme]{theme}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides, and is combined with, the plot's theme.} \item{position}{A character string indicating where the legend should be placed relative to the plot panels.} @@ -87,18 +33,11 @@ placed relative to the plot panels.} \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} -\item{default.unit}{A character string indicating \code{\link[grid:unit]{grid::unit()}} -for \code{keywidth} and \code{keyheight}.} - \item{override.aes}{A list specifying aesthetic parameters of legend key. See details and examples.} -\item{nrow}{The desired number of rows of legends.} - -\item{ncol}{The desired number of column of legends.} - -\item{byrow}{logical. If \code{FALSE} (the default) the legend-matrix is -filled by columns, otherwise the legend-matrix is filled by rows.} +\item{nrow, ncol}{The desired number of rows and column of legends +respectively.} \item{reverse}{logical. If \code{TRUE} the order of legends is reversed.} @@ -134,36 +73,32 @@ p1 + scale_fill_continuous(guide = guide_legend()) # Control styles # title position -p1 + guides(fill = guide_legend(title = "LEFT", title.position = "left")) +p1 + guides(fill = guide_legend( + title = "LEFT", theme(legend.title.position = "left") +)) # title text styles via element_text -p1 + guides(fill = - guide_legend( - title.theme = element_text( - size = 15, - face = "italic", - colour = "red", - angle = 0 - ) - ) -) +p1 + guides(fill = guide_legend(theme = theme( + legend.title = element_text(size = 15, face = "italic", colour = "red") +))) # label position -p1 + guides(fill = guide_legend(label.position = "left", label.hjust = 1)) +p1 + guides(fill = guide_legend(theme = theme( + legend.text.position = "left", + legend.text = element_text(hjust = 1) +))) # label styles p1 + scale_fill_continuous( breaks = c(5, 10, 15), labels = paste("long", c(5, 10, 15)), - guide = guide_legend( - direction = "horizontal", - title.position = "top", - label.position = "bottom", - label.hjust = 0.5, - label.vjust = 1, - label.theme = element_text(angle = 90) - ) + guide = guide_legend(theme = theme( + legend.direction = "horizontal", + legend.title.position = "top", + legend.text.position = "bottom", + legend.text = element_text(hjust = 0.5, vjust = 1, angle = 90) + )) ) # Set aesthetic of legend key @@ -180,7 +115,7 @@ p <- ggplot(df, aes(x, y)) + geom_point(aes(colour = color)) p + guides(col = guide_legend(nrow = 8)) p + guides(col = guide_legend(ncol = 8)) -p + guides(col = guide_legend(nrow = 8, byrow = TRUE)) +p + guides(col = guide_legend(nrow = 8, theme = theme(legend.byrow = TRUE))) # reversed order legend p + guides(col = guide_legend(reverse = TRUE)) diff --git a/man/theme.Rd b/man/theme.Rd index f0f7b179e1..8f4ea20015 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -66,11 +66,21 @@ theme( legend.key.size, legend.key.height, legend.key.width, + legend.key.spacing, + legend.key.spacing.x, + legend.key.spacing.y, + legend.frame, + legend.ticks, + legend.ticks.length, + legend.axis.line, legend.text, + legend.text.position, legend.title, + legend.title.position, legend.position, legend.position.inside, legend.direction, + legend.byrow, legend.justification, legend.justification.top, legend.justification.bottom, @@ -188,12 +198,32 @@ inherits from \code{rect})} \item{legend.key.size, legend.key.height, legend.key.width}{size of legend keys (\code{unit}); key background height & width inherit from \code{legend.key.size} or can be specified separately} +\item{legend.key.spacing, legend.key.spacing.x, legend.key.spacing.y}{spacing +between legend keys given as a \code{unit}. Spacing in the horizontal (x) and +vertical (y) direction inherit from \code{legend.key.spacing} or can be +specified separately.} + +\item{legend.frame}{frame drawn around the bar (\code{\link[=element_rect]{element_rect()}}).} + +\item{legend.ticks}{tick marks shown along bars or axes (\code{\link[=element_line]{element_line()}})} + +\item{legend.ticks.length}{length of tick marks in legend (\code{unit})} + +\item{legend.axis.line}{lines along axes in legends (\code{\link[=element_line]{element_line()}})} + \item{legend.text}{legend item labels (\code{\link[=element_text]{element_text()}}; inherits from \code{text})} +\item{legend.text.position}{placement of legend text relative to legend keys +or bars ("top", "right", "bottom" or "left"). The legend text placement +might be incompatible with the legend's direction for some guides.} + \item{legend.title}{title of legend (\code{\link[=element_text]{element_text()}}; inherits from \code{title})} +\item{legend.title.position}{placement of legend title relative to the main +legend ("top", "right", "bottom" or "left").} + \item{legend.position}{the default position of legends ("none", "left", "right", "bottom", "top", "inside")} @@ -203,6 +233,9 @@ placement of legends that have the \code{"inside"} position.} \item{legend.direction}{layout of items in legends ("horizontal" or "vertical")} +\item{legend.byrow}{whether the legend-matrix is filled by columns +(\code{FALSE}, the default) or by rows (\code{TRUE}).} + \item{legend.justification}{anchor point for positioning legend inside plot ("center" or two-element numeric vector) or the justification according to the plot area when positioned outside the plot} diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index 3703c52d09..8b3b7ed57f 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -18,7 +18,7 @@ --- - `title.position` must be one of "top", "right", "bottom", or "left", not "leftish". + `legend.title.position` must be one of "top", "right", "bottom", or "left", not "leftish". --- @@ -27,15 +27,15 @@ --- - When `direction` is "vertical", `label.position` must be one of "right" or "left", not "top". + When `direction` is "vertical", `legend.text.position` must be one of "right" or "left", not "top". --- - When `direction` is "horizontal", `label.position` must be one of "bottom" or "top", not "left". + When `direction` is "horizontal", `legend.text.position` must be one of "bottom" or "top", not "left". --- - `label.position` must be one of "top", "right", "bottom", or "left", not "test". + `legend.text.position` must be one of "top", "right", "bottom", or "left", not "test". i Did you mean "left"? --- diff --git a/tests/testthat/_snaps/guides/left-aligned-legend-key.svg b/tests/testthat/_snaps/guides/left-aligned-legend-key.svg index e71689c336..fc84b274ea 100644 --- a/tests/testthat/_snaps/guides/left-aligned-legend-key.svg +++ b/tests/testthat/_snaps/guides/left-aligned-legend-key.svg @@ -104,16 +104,16 @@ 400 disp mpg - + - - - - -4 -6 -8 + + + + +4 +6 +8 left aligned legend key diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 2bee90f460..1614da03ea 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -233,20 +233,24 @@ test_that("guide specifications are properly checked", { expect_snapshot_warning(ggplotGrob(p)) - expect_snapshot_error(guide_legend(title.position = "leftish")) + p <- p + guides(shape = guide_legend(theme = theme(legend.title.position = "leftish"))) + expect_snapshot_error(ggplotGrob(p)) expect_snapshot_error(guide_colourbar()$transform()) p <- ggplot(mtcars) + geom_point(aes(mpg, disp, colour = gear)) + - guides(colour = guide_colourbar(label.position = "top")) + guides(colour = guide_colourbar(theme = theme(legend.text.position = "top"))) expect_snapshot_error(ggplotGrob(p)) p <- ggplot(mtcars) + geom_point(aes(mpg, disp, colour = gear)) + - guides(colour = guide_colourbar(direction = "horizontal", label.position = "left")) + guides(colour = guide_colourbar(direction = "horizontal", theme = theme(legend.text.position = "left"))) expect_snapshot_error(ggplotGrob(p)) - expect_snapshot_error(guide_legend(label.position = "test")) + p <- ggplot(mtcars) + + geom_point(aes(mpg, disp, colour = gear)) + + guides(colour = guide_legend(theme = theme(legend.text.position = "test"))) + expect_snapshot_error(ggplotGrob(p)) p <- ggplot(mtcars) + geom_point(aes(mpg, disp, colour = gear)) + guides(colour = guide_legend(nrow = 2, ncol = 2)) @@ -414,9 +418,12 @@ test_that("guide_axis_logticks calculates appropriate ticks", { test_that("guide_legend uses key.spacing correctly", { p <- ggplot(mtcars, aes(disp, mpg, colour = factor(carb))) + geom_point() + - guides(colour = guide_legend( - ncol = 2, key.spacing.y = 1, key.spacing.x = 2 - )) + guides(colour = guide_legend(ncol = 2)) + + theme_test() + + theme( + legend.key.spacing.x = unit(2, "lines"), + legend.key.spacing.y = unit(1, "lines") + ) expect_doppelganger("legend with widely spaced keys", p) }) @@ -810,8 +817,10 @@ test_that("guides title and text are positioned correctly", { scale_colour_continuous( name = "value", guide = guide_colorbar( - title.theme = element_text(size = 11, angle = 0, hjust = 0.5, vjust = 1), - label.theme = element_text(size = 0.8*11, angle = 270, hjust = 0.5, vjust = 1), + theme = theme( + legend.title = element_text(size = 11, angle = 0, hjust = 0.5, vjust = 1), + legend.text = element_text(size = 0.8 * 11, angle = 270, hjust = 0.5, vjust = 1) + ), order = 2 # set guide order to keep visual test stable ) ) + @@ -822,10 +831,12 @@ test_that("guides title and text are positioned correctly", { name = "fill value", guide = guide_legend( direction = "horizontal", - title.position = "top", - label.position = "bottom", - title.theme = element_text(size = 11, angle = 180, hjust = 0, vjust = 1), - label.theme = element_text(size = 0.8*11, angle = 90, hjust = 1, vjust = 0.5), + theme = theme( + legend.title.position = "top", + legend.text.position = "bottom", + legend.title = element_text(size = 11, angle = 180, hjust = 0, vjust = 1), + legend.text = element_text(size = 0.8 * 11, angle = 90, hjust = 1, vjust = 0.5) + ), order = 1 ) ) @@ -838,13 +849,32 @@ test_that("guides title and text are positioned correctly", { geom_point() + scale_alpha(breaks = 1:2) + guides( - colour = guide_legend("colour title with hjust = 0", title.hjust = 0, order = 1), - fill = guide_legend("fill title with hjust = 1", title.hjust = 1, order = 2, - title.position = "bottom", override.aes = list(shape = 21)), - alpha = guide_legend("Title\nfor\nalpha\nwith\nvjust=0", title.vjust = 0, - title.position = "left", order = 3), - shape = guide_legend("Title\nfor\nshape\nwith\nvjust=1", title.vjust = 1, - title.position = "right", order = 4) + colour = guide_legend( + "colour title with hjust = 0", order = 1, + theme = theme(legend.title = element_text(hjust = 0)) + ), + fill = guide_legend( + "fill title with hjust = 1", order = 2, + theme = theme( + legend.title = element_text(hjust = 1), + legend.title.position = "bottom" + ), + override.aes = list(shape = 21) + ), + alpha = guide_legend( + "Title\nfor\nalpha\nwith\nvjust=0", order = 3, + theme = theme( + legend.title = element_text(vjust = 0), + legend.title.position = "left" + ) + ), + shape = guide_legend( + "Title\nfor\nshape\nwith\nvjust=1", order = 4, + theme = theme( + legend.title = element_text(vjust = 1), + legend.title.position = "right" + ) + ) ) expect_doppelganger("legends with all title justifications", p) }) @@ -870,16 +900,16 @@ test_that("colorbar can be styled", { expect_doppelganger("white-to-red colorbar, long thick black ticks, green frame", p + scale_color_gradient( - low = 'white', high = 'red', - guide = guide_colorbar( - frame = element_rect(colour = "green"), - frame.linewidth = 1.5 / .pt, - ticks.colour = "black", - ticks.linewidth = 2.5 / .pt, - ticks.length = unit(0.4, "npc") - ) + low = 'white', high = 'red', + guide = guide_colorbar( + theme = theme( + legend.frame = element_rect(colour = "green", linewidth = 1.5 / .pt), + legend.ticks = element_line("black", linewidth = 2.5 / .pt), + legend.ticks.length = unit(0.4, "npc") ) + ) ) + ) }) test_that("guides can handle multiple aesthetics for one scale", { @@ -909,10 +939,21 @@ test_that("bin guide can be styled correctly", { p + guides(size = guide_bins(show.limits = TRUE)) ) expect_doppelganger("guide_bins can show arrows", - p + guides(size = guide_bins(axis.arrow = arrow(length = unit(1.5, "mm"), ends = "both"))) + p + guides(size = guide_bins()) + + theme_test() + + theme( + legend.axis.line = element_line( + linewidth = 0.5 / .pt, + arrow = arrow(length = unit(1.5, "mm"), ends = "both") + ) + ) ) expect_doppelganger("guide_bins can remove axis", - p + guides(size = guide_bins(axis = FALSE)) + p + guides(size = guide_bins()) + + theme_test() + + theme( + legend.axis.line = element_blank() + ) ) expect_doppelganger("guide_bins work horizontally", p + guides(size = guide_bins(direction = "horizontal")) @@ -935,7 +976,9 @@ test_that("coloursteps guide can be styled correctly", { p + guides(colour = guide_coloursteps(even.steps = FALSE)) ) expect_doppelganger("guide_bins can show ticks", - p + guides(colour = guide_coloursteps(ticks = TRUE)) + p + guides(colour = guide_coloursteps( + theme = theme(legend.ticks = element_line(linewidth = 0.5 / .pt, colour = "white")) + )) ) }) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index dcaba82966..146ad29fc8 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -806,8 +806,8 @@ test_that("legend margins are correct when using relative key sizes", { ) vertical <- p + guides( - colour = guide_colourbar(barheight = unit(1, "null")), - shape = guide_legend(keyheight = unit(1/3, "null")) + colour = guide_colourbar(theme = theme(legend.key.height = unit(1, "null"))), + shape = guide_legend(theme = theme(legend.key.height = unit(1/3, "null"))) ) + theme( legend.box.margin = margin(t = 5, b = 10, unit = "mm"), legend.margin = margin(t = 10, b = 5, unit = "mm") @@ -816,8 +816,8 @@ test_that("legend margins are correct when using relative key sizes", { expect_doppelganger("stretched vertical legends", vertical) horizontal <- p + guides( - colour = guide_colourbar(barwidth = unit(1, "null")), - shape = guide_legend(keywidth = unit(1/3, "null")) + colour = guide_colourbar(theme = theme(legend.key.width = unit(1, "null"))), + shape = guide_legend(theme = theme(legend.key.width = unit(1/3, "null"))) ) + theme( legend.position = "top", legend.box.margin = margin(l = 5, r = 10, unit = "mm"), From 000a9392ed3bf9df813baa442b777edac0b044f9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 14 Dec 2023 10:14:15 +0100 Subject: [PATCH 22/22] Rename `trans` arguments to `transform` (#5566) * switch `trans` -> `transform` in constructors * swap `trans` -> `transform` in secondary axes * migrate `trans` -> `transform` in scale functions * propagate `trans` -> `transform` in other functions * adjust test verbiage * reoxygenate * add news bullet * document sec axis * don't namespace deprecated * rename trans field * fix sec axis bug * fallback mechanism * deprecation message * transformer -> transformation * rename `AxisSecondary$trans` slot * Implement `get_transformation()` method * Use `get_transformation()` * Document `get_transformation()` method --- NEWS.md | 7 +- R/axis-secondary.R | 54 ++++++---- R/coord-transform.R | 6 +- R/fortify-multcomp.R | 2 +- R/guide-axis-logticks.R | 12 +-- R/limits.R | 2 +- R/scale-.R | 116 +++++++++++++-------- R/scale-binned.R | 19 ++-- R/scale-continuous.R | 30 +++--- R/scale-date.R | 15 +-- R/scale-expansion.R | 5 +- R/scale-linewidth.R | 15 +-- R/scale-size.R | 23 ++-- R/scale-view.R | 1 + R/scales-.R | 6 +- R/stat-function.R | 4 +- man/binned_scale.Rd | 10 +- man/continuous_scale.Rd | 10 +- man/datetime_scale.Rd | 16 ++- man/fortify-multcomp.Rd | 2 +- man/ggplot2-ggproto.Rd | 7 +- man/guide_axis_logticks.Rd | 2 +- man/scale_binned.Rd | 13 ++- man/scale_continuous.Rd | 17 +-- man/scale_gradient.Rd | 6 +- man/scale_linewidth.Rd | 13 ++- man/scale_size.Rd | 16 ++- man/scale_steps.Rd | 6 +- man/sec_axis.Rd | 12 ++- tests/testthat/test-coord-transform.R | 2 +- tests/testthat/test-guides.R | 10 +- tests/testthat/test-plot-summary-api.R | 14 +-- tests/testthat/test-scale-binned.R | 10 +- tests/testthat/test-scales-breaks-labels.R | 12 +-- tests/testthat/test-scales.R | 20 ++-- tests/testthat/test-sec-axis.R | 19 ++-- vignettes/extending-ggplot2.Rmd | 2 +- 37 files changed, 328 insertions(+), 208 deletions(-) diff --git a/NEWS.md b/NEWS.md index db9d477402..55dffd0401 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,17 @@ # ggplot2 (development version) +* The `trans` argument in scales and secondary axes has been renamed to + `transform`. The `trans` argument itself is deprecated. To access the + transformation from the scale, a new `get_transformation()` method is + added to Scale-classes (#5558). + * `guide_*()` functions get a new `theme` argument to style individual guides. The `theme()` function has gained additional arguments for styling guides: `legend.key.spacing{.x/.y}`, `legend.frame`, `legend.axis.line`, `legend.ticks`, `legend.ticks.length`, `legend.text.position` and `legend.title.position`. Previous style arguments in the `guide_*()` functions have been soft-deprecated. - + * When legend titles are larger than the legend, title justification extends to the placement of keys and labels (#1903). diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 06565358c6..673cc0ef5b 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -4,7 +4,9 @@ #' secondary axis, positioned opposite of the primary axis. All secondary #' axes must be based on a one-to-one transformation of the primary axes. #' -#' @param trans A formula or function of transformation +#' @param transform A formula or function of transformation +#' +#' @param trans `r lifecycle::badge("deprecated")` #' #' @param name The name of the secondary axis #' @@ -94,14 +96,20 @@ #' ) #' #' @export -sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = waiver(), - guide = waiver()) { +sec_axis <- function(transform = NULL, + name = waiver(), breaks = waiver(), labels = waiver(), + guide = waiver(), trans = deprecated()) { + if (lifecycle::is_present(trans)) { + deprecate_soft0("3.5.0", "sec_axis(trans)", "sec_axis(transform)") + transform <- trans + } + # sec_axis() historically accepted two-sided formula, so be permissive. - if (length(trans) > 2) trans <- trans[c(1,3)] + if (length(transform) > 2) transform <- transform[c(1,3)] - trans <- as_function(trans) + transform <- as_function(transform) ggproto(NULL, AxisSecondary, - trans = trans, + transform = transform, name = name, breaks = breaks, labels = labels, @@ -111,8 +119,9 @@ sec_axis <- function(trans = NULL, name = waiver(), breaks = waiver(), labels = #' @rdname sec_axis #' #' @export -dup_axis <- function(trans = ~., name = derive(), breaks = derive(), labels = derive(), guide = derive()) { - sec_axis(trans, name, breaks, labels, guide) +dup_axis <- function(transform = ~., trans = deprecated(), + name = derive(), breaks = derive(), labels = derive(), guide = derive()) { + sec_axis(transform, trans = trans, name, breaks, labels, guide) } is.sec_axis <- function(x) { @@ -144,7 +153,7 @@ is.derived <- function(x) { #' @usage NULL #' @export AxisSecondary <- ggproto("AxisSecondary", NULL, - trans = NULL, + transform = NULL, axis = NULL, name = waiver(), breaks = waiver(), @@ -156,7 +165,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, detail = 1000, empty = function(self) { - is.null(self$trans) + is.null(self$transform %||% self$trans) }, # Inherit settings from the primary axis/scale @@ -164,18 +173,19 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (self$empty()) { return() } - if (!is.function(self$trans)) { + transform <- self$transform %||% self$trans + if (!is.function(transform)) { cli::cli_abort("Transformation for secondary axes must be a function.") } if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks - if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks + if (is.waive(self$breaks)) self$breaks <- scale$transformation$breaks if (is.derived(self$labels)) self$labels <- scale$labels if (is.derived(self$guide)) self$guide <- scale$guide }, transform_range = function(self, range) { - self$trans(range) + self$transform(range) }, mono_test = function(self, scale){ @@ -186,8 +196,9 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, return() } + transformation <- scale$get_transformation() along_range <- seq(range[1], range[2], length.out = self$detail) - old_range <- scale$trans$inverse(along_range) + old_range <- transformation$inverse(along_range) # Create mapping between primary and secondary range full_range <- self$transform_range(old_range) @@ -204,8 +215,9 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, self$mono_test(scale) # Get scale's original range before transformation + transformation <- scale$get_transformation() along_range <- seq(range[1], range[2], length.out = self$detail) - old_range <- scale$trans$inverse(along_range) + old_range <- transformation$inverse(along_range) # Create mapping between primary and secondary range full_range <- self$transform_range(old_range) @@ -225,8 +237,8 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # patch for date and datetime scales just to maintain functionality # works only for linear secondary transforms that respect the time or date transform - if (scale$trans$name %in% c("date", "time")) { - temp_scale <- self$create_scale(new_range, trans = scale$trans) + if (transformation$name %in% c("date", "time")) { + temp_scale <- self$create_scale(new_range, transformation = transformation) range_info <- temp_scale$break_info() old_val_trans <- rescale(range_info$major, from = c(0, 1), to = range) old_val_minor_trans <- rescale(range_info$minor, from = c(0, 1), to = range) @@ -237,7 +249,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Map the break values back to their correct position on the primary scale if (!is.null(range_info$major_source)) { old_val <- stats::approx(full_range, old_range, range_info$major_source)$y - old_val_trans <- scale$trans$transform(old_val) + old_val_trans <- transformation$transform(old_val) # rescale values from 0 to 1 range_info$major[] <- round( @@ -253,7 +265,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (!is.null(range_info$minor_source)) { old_val_minor <- stats::approx(full_range, old_range, range_info$minor_source)$y - old_val_minor_trans <- scale$trans$transform(old_val_minor) + old_val_minor_trans <- transformation$transform(old_val_minor) range_info$minor[] <- round( rescale( @@ -280,14 +292,14 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, }, # Temporary scale for the purpose of calling break_info() - create_scale = function(self, range, trans = transform_identity()) { + create_scale = function(self, range, transformation = transform_identity()) { scale <- ggproto(NULL, ScaleContinuousPosition, name = self$name, breaks = self$breaks, labels = self$labels, limits = range, expand = c(0, 0), - trans = trans + transformation = transformation ) scale$train(range) scale diff --git a/R/coord-transform.R b/R/coord-transform.R index 9fde8bb98e..79d651e8af 100644 --- a/R/coord-transform.R +++ b/R/coord-transform.R @@ -190,8 +190,8 @@ transform_value <- function(trans, value, range) { # TODO: can we merge this with view_scales_from_scale()? view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) - scale_trans <- scale$trans %||% transform_identity() - coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) + transformation <- scale$get_transformation() %||% transform_identity() + coord_limits <- coord_limits %||% transformation$inverse(c(NA, NA)) scale_limits <- scale$get_limits() if (scale$is_discrete()) { @@ -204,7 +204,7 @@ view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, ) } else { # transform user-specified limits to scale transformed space - coord_limits <- scale$trans$transform(coord_limits) + coord_limits <- transformation$transform(coord_limits) continuous_ranges <- expand_limits_continuous_trans( scale_limits, expansion, diff --git a/R/fortify-multcomp.R b/R/fortify-multcomp.R index 0c79c75784..79714b2a68 100644 --- a/R/fortify-multcomp.R +++ b/R/fortify-multcomp.R @@ -22,7 +22,7 @@ #' ggplot(mapping = aes(lhs, estimate)) + #' geom_linerange(aes(ymin = lwr, ymax = upr), data = CI) + #' geom_point(aes(size = p), data = summary(wht)) + -#' scale_size(trans = "reverse") +#' scale_size(transform = "reverse") #' #' cld <- cld(wht) #' fortify(cld) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index d7742c8cc6..a07e095de8 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -55,7 +55,7 @@ NULL #' geom_density() + #' scale_x_continuous( #' breaks = c(-10^(4:0), 0, 10^(0:4)), -#' trans = "pseudo_log" +#' transform = "pseudo_log" #' ) #' #' # The log ticks are mirrored when 0 is included @@ -149,20 +149,20 @@ GuideAxisLogticks <- ggproto( # Reconstruct a transformation if user has prescaled data if (!is.null(params$prescale_base)) { - trans_name <- scale$scale$trans$name + trans_name <- scale$scale$transformation$name if (trans_name != "identity") { cli::cli_warn(paste0( "The {.arg prescale_base} argument will override the scale's ", "{.field {trans_name}} transformation in log-tick positioning." )) } - trans <- transform_log(base = params$prescale_base) + transformation <- transform_log(base = params$prescale_base) } else { - trans <- scale$scale$trans + transformation <- scale$get_transformation() } # Reconstruct original range - limits <- trans$inverse(scale$get_limits()) + limits <- transformation$inverse(scale$get_limits()) has_negatives <- any(limits <= 0) if (!has_negatives) { @@ -190,7 +190,7 @@ GuideAxisLogticks <- ggproto( } # Set ticks back into transformed space - ticks <- trans$transform(c(tens, fives, ones)) + ticks <- transformation$transform(c(tens, fives, ones)) nticks <- c(length(tens), length(fives), length(ones)) logkey <- data_frame0( diff --git a/R/limits.R b/R/limits.R index be1a42ba6f..26528ee7ff 100644 --- a/R/limits.R +++ b/R/limits.R @@ -122,7 +122,7 @@ limits.numeric <- function(lims, var, call = caller_env()) { trans <- "identity" } - make_scale("continuous", var, limits = lims, trans = trans, call = call) + make_scale("continuous", var, limits = lims, transform = trans, call = call) } make_scale <- function(type, var, ..., call = NULL) { diff --git a/R/scale-.R b/R/scale-.R index d4a4eaa857..2d22133fae 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -67,7 +67,7 @@ #' - [scales::squish()] for squishing out of bounds values into range. #' - [scales::squish_infinite()] for squishing infinite values into range. #' @param na.value Missing values will be replaced with this value. -#' @param trans For continuous scales, the name of a transformation object +#' @param transform For continuous scales, the name of a transformation object #' or the object itself. Built-in transformations include "asn", "atanh", #' "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", #' "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -75,10 +75,12 @@ #' #' A transformation object bundles together a transform, its inverse, #' and methods for generating breaks and labels. Transformation objects -#' are defined in the scales package, and are called `_trans`. If +#' are defined in the scales package, and are called `transform_`. If #' transformations require arguments, you can call them from the scales #' package, e.g. [`scales::transform_boxcox(p = 2)`][scales::transform_boxcox]. #' You can create your own transformation with [scales::new_transform()]. +#' @param trans `r lifecycle::badge("deprecated")` Deprecated in favour of +#' `transform`. #' @param guide A function used to create a guide or its name. See #' [guides()] for more information. #' @param expand For position scales, a vector of range expansion constants used to add some @@ -96,13 +98,18 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, - trans = "identity", guide = "legend", position = "left", + transform = "identity", trans = deprecated(), + guide = "legend", position = "left", call = caller_call(), super = ScaleContinuous) { call <- call %||% current_call() if (lifecycle::is_present(scale_name)) { deprecate_soft0("3.5.0", "continuous_scale(scale_name)") } + if (lifecycle::is_present(trans)) { + deprecate_soft0("3.5.0", "continuous_scale(trans)", "continuous_scale(transform)") + transform <- trans + } aesthetics <- standardise_aes_names(aesthetics) @@ -115,9 +122,9 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam guide <- "none" } - trans <- as.transform(trans) + transform <- as.transform(transform) if (!is.null(limits) && !is.function(limits)) { - limits <- trans$transform(limits) + limits <- transform$transform(limits) } # Convert formula to function if appropriate @@ -136,7 +143,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam range = ContinuousRange$new(), limits = limits, - trans = trans, + transformation = transform, na.value = na.value, expand = expand, rescaler = rescaler, @@ -261,13 +268,19 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = breaks = waiver(), labels = waiver(), limits = NULL, rescaler = rescale, oob = squish, expand = waiver(), na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, - right = TRUE, trans = "identity", show.limits = FALSE, + right = TRUE, transform = "identity", + trans = deprecated(), show.limits = FALSE, guide = "bins", position = "left", call = caller_call(), super = ScaleBinned) { if (lifecycle::is_present(scale_name)) { deprecate_soft0("3.5.0", "binned_scale(scale_name)") } + if (lifecycle::is_present(trans)) { + deprecate_soft0("3.5.0", "binned_scale(trans)", "binned_scale(transform)") + transform <- trans + } + call <- call %||% current_call() aesthetics <- standardise_aes_names(aesthetics) @@ -280,9 +293,9 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = guide <- "none" } - trans <- as.transform(trans) + transform <- as.transform(transform) if (!is.null(limits)) { - limits <- trans$transform(limits) + limits <- transform$transform(limits) } # Convert formula input to function if appropriate @@ -300,7 +313,7 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = range = ContinuousRange$new(), limits = limits, - trans = trans, + transformation = transform, na.value = na.value, expand = expand, rescaler = rescaler, @@ -343,7 +356,7 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = #' - `clone()` Returns a copy of the scale that can be trained #' independently without affecting the original scale. #' -#' - `transform()` Transforms a vector of values using `self$trans`. +#' - `transform()` Transforms a vector of values using `self$transformation`. #' This occurs before the `Stat` is calculated. #' #' - `train()` Update the `self$range` of observed (transformed) data values with @@ -373,7 +386,7 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = #' (`self$range`). #' #' - `get_breaks()` Calculates the final scale breaks in transformed data space -#' based on on the combination of `self$breaks`, `self$trans$breaks()` (for +#' based on on the combination of `self$breaks`, `self$transformation$breaks()` (for #' continuous scales), and `limits`. Breaks outside of `limits` are assigned #' a value of `NA` (continuous scales) or dropped (discrete scales). #' @@ -382,7 +395,9 @@ binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = #' #' - `get_breaks_minor()` For continuous scales, calculates the final scale minor breaks #' in transformed data space based on the rescaled `breaks`, the value of `self$minor_breaks`, -#' and the value of `self$trans$minor_breaks()`. Discrete scales always return `NULL`. +#' and the value of `self$transformation$minor_breaks()`. Discrete scales always return `NULL`. +#' +#' - `get_transformation()` Returns the scale's transformation object. #' #' - `make_title()` Hook to modify the title that is calculated during guide construction #' (for non-position scales) or when the `Layout` calculates the x and y labels @@ -538,6 +553,14 @@ Scale <- ggproto("Scale", NULL, cli::cli_abort("Not implemented.", call = self$call) }, + get_transformation = function(self) { + if (!is.null(self$trans)) { + deprecate_soft0("3.5.0", I("Scale$trans"), I("Scale$transformation")) + return(self$trans) + } + self$transformation + }, + clone = function(self) { cli::cli_abort("Not implemented.", call = self$call) }, @@ -584,8 +607,9 @@ check_breaks_labels <- function(breaks, labels, call = NULL) { } default_transform <- function(self, x) { - new_x <- self$trans$transform(x) - check_transformation(x, new_x, self$trans$name, self$call) + transformation <- self$get_transformation() + new_x <- transformation$transform(x) + check_transformation(x, new_x, self$transformation$name, self$call) new_x } @@ -605,7 +629,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, oob = censor, minor_breaks = waiver(), n.breaks = NULL, - trans = transform_identity(), + transformation = transform_identity(), is_discrete = function() FALSE, @@ -654,8 +678,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (is.null(self$limits)) { self$range$range } else if (is.function(self$limits)) { + transformation <- self$get_transformation() # if limits is a function, it expects to work in data space - self$trans$transform(self$limits(self$trans$inverse(self$range$range))) + transformation$transform(self$limits(transformation$inverse(self$range$range))) } else { # NA limits for a continuous scale mean replace with the min/max of data ifelse(is.na(self$limits), self$range$range, self$limits) @@ -670,9 +695,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (self$is_empty()) { return(numeric()) } - + transformation <- self$get_transformation() # Ensure limits don't exceed domain (#980) - domain <- suppressWarnings(self$trans$transform(self$trans$domain)) + domain <- suppressWarnings(transformation$transform(transformation$domain)) domain <- sort(domain) # To avoid NaN causing issues. NaN are dropped by the sort() if (length(domain) == 2 && !zero_range(domain)) { @@ -680,7 +705,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } # Limits in transformed space need to be converted back to data space - limits <- self$trans$inverse(limits) + limits <- transformation$inverse(limits) if (is.null(self$breaks)) { return(NULL) @@ -695,19 +720,19 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # Compute `zero_range()` in transformed space in case `limits` in data space # don't support conversion to numeric (#5304) - if (zero_range(as.numeric(self$trans$transform(limits)))) { + if (zero_range(as.numeric(transformation$transform(limits)))) { breaks <- limits[1] } else if (is.waive(self$breaks)) { - if (!is.null(self$n.breaks) && trans_support_nbreaks(self$trans)) { - breaks <- self$trans$breaks(limits, self$n.breaks) + if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { + breaks <- transformation$breaks(limits, self$n.breaks) } else { if (!is.null(self$n.breaks)) { cli::cli_warn( - "Ignoring {.arg n.breaks}. Use a {.cls trans} object that supports setting number of breaks.", + "Ignoring {.arg n.breaks}. Use a {.cls transform} object that supports setting number of breaks.", call = self$call ) } - breaks <- self$trans$breaks(limits) + breaks <- transformation$breaks(limits) } } else if (is.function(self$breaks)) { breaks <- self$breaks(limits) @@ -716,7 +741,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } # Breaks in data space need to be converted back to transformed space - self$trans$transform(breaks) + transformation$transform(breaks) }, get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { @@ -738,11 +763,12 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # some transforms assume finite major breaks b <- b[is.finite(b)] + transformation <- self$get_transformation() if (is.waive(self$minor_breaks)) { if (is.null(b)) { breaks <- NULL } else { - breaks <- self$trans$minor_breaks(b, limits, n) + breaks <- transformation$minor_breaks(b, limits, n) } } else if (is.function(self$minor_breaks)) { # Using `fetch_ggproto` here to avoid auto-wrapping the user-supplied @@ -752,14 +778,14 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # Find breaks in data space if (length(arg_names) == 1L) { - breaks <- break_fun(self$trans$inverse(limits)) + breaks <- break_fun(transformation$inverse(limits)) } else { - breaks <- break_fun(self$trans$inverse(limits), self$trans$inverse(b)) + breaks <- break_fun(transformation$inverse(limits), transformation$inverse(b)) } # Convert breaks to numeric - breaks <- self$trans$transform(breaks) + breaks <- transformation$transform(breaks) } else { - breaks <- self$trans$transform(self$minor_breaks) + breaks <- transformation$transform(self$minor_breaks) } # Any minor breaks outside the dimensions need to be thrown away @@ -771,7 +797,8 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, return(NULL) } - breaks <- self$trans$inverse(breaks) + transformation <- self$get_transformation() + breaks <- transformation$inverse(breaks) if (is.null(self$labels)) { return(NULL) @@ -785,7 +812,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (is.waive(self$labels)) { - labels <- self$trans$format(breaks) + labels <- transformation$format(breaks) } else if (is.function(self$labels)) { labels <- self$labels(breaks) } else { @@ -1138,7 +1165,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, get_breaks = function(self, limits = self$get_limits()) { if (self$is_empty()) return(numeric()) - limits <- self$trans$inverse(limits) + transformation <- self$get_transformation() + + limits <- transformation$inverse(limits) is_rev <- limits[2] < limits[1] limits <- sort(limits) @@ -1151,8 +1180,8 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, ) } else if (is.waive(self$breaks)) { if (self$nice.breaks) { - if (!is.null(self$n.breaks) && trans_support_nbreaks(self$trans)) { - breaks <- self$trans$breaks(limits, n = self$n.breaks) + if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { + breaks <- transformation$breaks(limits, n = self$n.breaks) } else { if (!is.null(self$n.breaks)) { cli::cli_warn( @@ -1160,7 +1189,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, call = self$call ) } - breaks <- self$trans$breaks(limits) + breaks <- transformation$breaks(limits) } } else { n.breaks <- self$n.breaks %||% 5 # same default as trans objects @@ -1191,12 +1220,12 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, bin_size <- max(breaks[1] - limits[1], limits[2] - breaks[1]) new_limits <- c(breaks[1] - bin_size, breaks[1] + bin_size) } - new_limits_trans <- suppressWarnings(self$trans$transform(new_limits)) + new_limits_trans <- suppressWarnings(transformation$transform(new_limits)) limits[is.finite(new_limits_trans)] <- new_limits[is.finite(new_limits_trans)] if (is_rev) { - self$limits <- rev(self$trans$transform(limits)) + self$limits <- rev(transformation$transform(limits)) } else { - self$limits <- self$trans$transform(limits) + self$limits <- transformation$transform(limits) } } } else if (is.function(self$breaks)) { @@ -1221,7 +1250,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, self$breaks <- breaks - self$trans$transform(breaks) + transformation$transform(breaks) }, get_breaks_minor = function(...) NULL, @@ -1229,7 +1258,8 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, get_labels = function(self, breaks = self$get_breaks()) { if (is.null(breaks)) return(NULL) - breaks <- self$trans$inverse(breaks) + transformation <- self$get_transformation() + breaks <- transformation$inverse(breaks) if (is.null(self$labels)) { return(NULL) @@ -1239,7 +1269,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, call = self$call ) } else if (is.waive(self$labels)) { - labels <- self$trans$format(breaks) + labels <- transformation$format(breaks) } else if (is.function(self$labels)) { labels <- self$labels(breaks) } else { diff --git a/R/scale-binned.R b/R/scale-binned.R index 1fb5444696..f69efda8a0 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -26,14 +26,17 @@ NULL scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, - right = TRUE, show.limits = FALSE, trans = "identity", + right = TRUE, show.limits = FALSE, transform = "identity", + trans = deprecated(), guide = waiver(), position = "bottom") { binned_scale( ggplot_global$x_aes, palette = identity, name = name, breaks = breaks, - labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, - show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition + labels = labels, limits = limits, expand = expand, oob = oob, + na.value = na.value, n.breaks = n.breaks, nice.breaks = nice.breaks, + right = right, transform = transform, trans = trans, + show.limits = show.limits, guide = guide, position = position, + super = ScaleBinnedPosition ) } @@ -43,14 +46,16 @@ scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, scale_y_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), oob = squish, na.value = NA_real_, - right = TRUE, show.limits = FALSE, trans = "identity", + right = TRUE, show.limits = FALSE, transform = "identity", + trans = deprecated(), guide = waiver(), position = "left") { binned_scale( ggplot_global$y_aes, palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, - n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, - show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition + n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, + transform = transform, trans = trans, show.limits = show.limits, + guide = guide, position = position, super = ScaleBinnedPosition ) } diff --git a/R/scale-continuous.R b/R/scale-continuous.R index 002e03316a..19b3e9cb44 100644 --- a/R/scale-continuous.R +++ b/R/scale-continuous.R @@ -2,7 +2,7 @@ #' #' `scale_x_continuous()` and `scale_y_continuous()` are the default #' scales for continuous x and y aesthetics. There are three variants -#' that set the `trans` argument for commonly used transformations: +#' that set the `transform` argument for commonly used transformations: #' `scale_*_log10()`, `scale_*_sqrt()` and `scale_*_reverse()`. #' #' For simple manipulation of labels and limits, you may wish to use @@ -64,7 +64,7 @@ #' p1 + scale_y_reverse() #' #' # Or you can supply a transformation in the `trans` argument: -#' p1 + scale_y_continuous(trans = scales::transform_reciprocal()) +#' p1 + scale_y_continuous(transform = scales::transform_reciprocal()) #' #' # You can also create your own. See ?scales::new_transform #' @@ -81,7 +81,8 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, transform = "identity", + trans = deprecated(), guide = waiver(), position = "bottom", sec.axis = waiver()) { call <- caller_call() @@ -92,8 +93,8 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), ggplot_global$x_aes, palette = identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, - expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = guide, position = position, call = call, + expand = expand, oob = oob, na.value = na.value, transform = transform, + trans = trans, guide = guide, position = position, call = call, super = ScaleContinuousPosition ) @@ -107,7 +108,8 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), limits = NULL, expand = waiver(), oob = censor, - na.value = NA_real_, trans = "identity", + na.value = NA_real_, transform = "identity", + trans = deprecated(), guide = waiver(), position = "left", sec.axis = waiver()) { call <- caller_call() @@ -118,8 +120,8 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(), ggplot_global$y_aes, palette = identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, - expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = guide, position = position, call = call, + expand = expand, oob = oob, na.value = na.value, transform = transform, + trans = trans, guide = guide, position = position, call = call, super = ScaleContinuousPosition ) @@ -169,30 +171,30 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous, #' @rdname scale_continuous #' @export scale_x_log10 <- function(...) { - scale_x_continuous(..., trans = transform_log10()) + scale_x_continuous(..., transform = transform_log10()) } #' @rdname scale_continuous #' @export scale_y_log10 <- function(...) { - scale_y_continuous(..., trans = transform_log10()) + scale_y_continuous(..., transform = transform_log10()) } #' @rdname scale_continuous #' @export scale_x_reverse <- function(...) { - scale_x_continuous(..., trans = transform_reverse()) + scale_x_continuous(..., transform = transform_reverse()) } #' @rdname scale_continuous #' @export scale_y_reverse <- function(...) { - scale_y_continuous(..., trans = transform_reverse()) + scale_y_continuous(..., transform = transform_reverse()) } #' @rdname scale_continuous #' @export scale_x_sqrt <- function(...) { - scale_x_continuous(..., trans = transform_sqrt()) + scale_x_continuous(..., transform = transform_sqrt()) } #' @rdname scale_continuous #' @export scale_y_sqrt <- function(...) { - scale_y_continuous(..., trans = transform_sqrt()) + scale_y_continuous(..., transform = transform_sqrt()) } diff --git a/R/scale-date.R b/R/scale-date.R index 6dfc419a1a..f607b78847 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -242,7 +242,7 @@ scale_x_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::transform_hms(), + transform = scales::transform_hms(), sec.axis = sec.axis ) } @@ -273,7 +273,7 @@ scale_y_time <- function(name = waiver(), na.value = na.value, guide = guide, position = position, - trans = scales::transform_hms(), + transform = scales::transform_hms(), sec.axis = sec.axis ) } @@ -288,8 +288,8 @@ scale_y_time <- function(name = waiver(), #' #' @export #' @keywords internal -datetime_scale <- function(aesthetics, trans, palette, - breaks = pretty_breaks(), minor_breaks = waiver(), +datetime_scale <- function(aesthetics, transform, trans = deprecated(), + palette, breaks = pretty_breaks(), minor_breaks = waiver(), labels = waiver(), date_breaks = waiver(), date_labels = waiver(), date_minor_breaks = waiver(), timezone = NULL, @@ -317,7 +317,7 @@ datetime_scale <- function(aesthetics, trans, palette, # ScaleContinuousDatetime; others use ScaleContinuous if (all(aesthetics %in% c("x", "xmin", "xmax", "xend", "y", "ymin", "ymax", "yend"))) { scale_class <- switch( - trans, + transform, date = ScaleContinuousDate, time = ScaleContinuousDatetime ) @@ -325,7 +325,7 @@ datetime_scale <- function(aesthetics, trans, palette, scale_class <- ScaleContinuous } - trans <- switch(trans, + transform <- switch(transform, date = transform_date(), time = transform_time(timezone) ) @@ -337,6 +337,7 @@ datetime_scale <- function(aesthetics, trans, palette, minor_breaks = minor_breaks, labels = labels, guide = guide, + transform = transform, trans = trans, call = call, ..., @@ -357,7 +358,7 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous, tz <- attr(x, "tzone") if (is.null(self$timezone) && !is.null(tz)) { self$timezone <- tz - self$trans <- transform_time(self$timezone) + self$transformation <- transform_time(self$timezone) } ggproto_parent(ScaleContinuous, self)$transform(x) }, diff --git a/R/scale-expansion.R b/R/scale-expansion.R index 5518e9f012..9ede4c1400 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -145,8 +145,9 @@ expand_limits_scale <- function(scale, expand = expansion(0, 0), limits = waiver } else { # using the inverse transform to resolve the NA value is needed for date/datetime/time # scales, which refuse to transform objects of the incorrect type - coord_limits <- coord_limits %||% scale$trans$inverse(c(NA_real_, NA_real_)) - coord_limits_scale <- scale$trans$transform(coord_limits) + transformation <- scale$get_transformation() + coord_limits <- coord_limits %||% transformation$inverse(c(NA_real_, NA_real_)) + coord_limits_scale <- transformation$transform(coord_limits) expand_limits_continuous(limits, expand, coord_limits_scale) } } diff --git a/R/scale-linewidth.R b/R/scale-linewidth.R index 71c87b199c..993e11f5e1 100644 --- a/R/scale-linewidth.R +++ b/R/scale-linewidth.R @@ -29,11 +29,12 @@ NULL #' @usage NULL scale_linewidth_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, - range = c(1, 6), trans = "identity", + range = c(1, 6), transform = "identity", + trans = deprecated(), guide = "legend") { continuous_scale("linewidth", palette = pal_rescale(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - guide = guide) + breaks = breaks, labels = labels, limits = limits, + transform = transform, trans = trans, guide = guide) } #' @rdname scale_linewidth @@ -44,10 +45,12 @@ scale_linewidth <- scale_linewidth_continuous #' @export scale_linewidth_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, - nice.breaks = TRUE, trans = "identity", guide = "bins") { + nice.breaks = TRUE, transform = "identity", + trans = deprecated(), guide = "bins") { binned_scale("linewidth", palette = pal_rescale(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) + breaks = breaks, labels = labels, limits = limits, + transform = transform, trans = trans, n.breaks = n.breaks, + nice.breaks = nice.breaks, guide = guide) } #' @rdname scale_linewidth diff --git a/R/scale-size.R b/R/scale-size.R index 07fd89f442..c1928fcf18 100644 --- a/R/scale-size.R +++ b/R/scale-size.R @@ -51,10 +51,12 @@ NULL #' @usage NULL scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", guide = "legend") { + transform = "identity", + trans = deprecated(), + guide = "legend") { continuous_scale("size", palette = pal_area(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - guide = guide) + breaks = breaks, labels = labels, limits = limits, + transform = transform, trans = trans, guide = guide) } #' @rdname scale_size @@ -65,20 +67,23 @@ scale_size <- scale_size_continuous #' @export scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", guide = "legend") { + transform = "identity", trans = deprecated(), + guide = "legend") { continuous_scale("size", palette = pal_rescale(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - guide = guide) + breaks = breaks, labels = labels, limits = limits, transform = transform, + trans = trans, guide = guide) } #' @rdname scale_size #' @export scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, - nice.breaks = TRUE, trans = "identity", guide = "bins") { + nice.breaks = TRUE, transform = "identity", + trans = deprecated(), guide = "bins") { binned_scale("size", palette = pal_area(range), name = name, - breaks = breaks, labels = labels, limits = limits, trans = trans, - n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) + breaks = breaks, labels = labels, limits = limits, + transform = transform, trans = trans, n.breaks = n.breaks, + nice.breaks = nice.breaks, guide = guide) } #' @rdname scale_size diff --git a/R/scale-view.R b/R/scale-view.R index 1402a3ffee..3a068ea81c 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -131,6 +131,7 @@ ViewScale <- ggproto("ViewScale", NULL, get_breaks = function(self) self$breaks, get_breaks_minor = function(self) self$minor_breaks, get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks), + get_transformation = function(self) self$scale$get_transformation(), rescale = function(self, x) { self$scale$rescale(x, self$limits, self$continuous_range) }, diff --git a/R/scales-.R b/R/scales-.R index 2d8ffbfe06..5e1fd3208a 100644 --- a/R/scales-.R +++ b/R/scales-.R @@ -90,7 +90,7 @@ ScalesList <- ggproto("ScalesList", NULL, # to transform anything idx_skip <- vapply(self$scales, function(x) { has_default_transform(x) && - (is.null(x$trans) || identical(x$trans$transform, identity)) + (is.null(x$transformation) || identical(x$transformation$transform, identity)) }, logical(1L)) scales <- self$scales[!idx_skip] @@ -114,7 +114,7 @@ ScalesList <- ggproto("ScalesList", NULL, # to transform anything idx_skip <- vapply(self$scales, function(x) { has_default_transform(x) && - (is.null(x$trans) || identical(x$trans$transform, identity)) + (is.null(x$transformation) || identical(x$transformation$transform, identity)) }, logical(1)) scales <- self$scales[!idx_skip] @@ -129,7 +129,7 @@ ScalesList <- ggproto("ScalesList", NULL, if (length(aesthetics) == 0) { return() } - lapply(df[aesthetics], scale$trans$inverse) + lapply(df[aesthetics], scale$transformation$inverse) } ), recursive = FALSE) diff --git a/R/stat-function.R b/R/stat-function.R index 8585d3b843..b43af4fb5a 100644 --- a/R/stat-function.R +++ b/R/stat-function.R @@ -66,7 +66,7 @@ StatFunction <- ggproto("StatFunction", Stat, } else { # For continuous scales, need to back transform from transformed range # to original values - x_trans <- scales$x$trans$inverse(xseq) + x_trans <- scales$x$transformation$inverse(xseq) } } @@ -75,7 +75,7 @@ StatFunction <- ggproto("StatFunction", Stat, y_out <- inject(fun(x_trans, !!!args)) if (!is.null(scales$y) && !scales$y$is_discrete()) { # For continuous scales, need to apply transform - y_out <- scales$y$trans$transform(y_out) + y_out <- scales$y$transformation$transform(y_out) } data_frame0(x = xseq, y = y_out) diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 31d70663f0..b03ae8201b 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -19,7 +19,8 @@ binned_scale( n.breaks = NULL, nice.breaks = TRUE, right = TRUE, - trans = "identity", + transform = "identity", + trans = deprecated(), show.limits = FALSE, guide = "bins", position = "left", @@ -120,7 +121,7 @@ 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{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -128,11 +129,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{show.limits}{should the limits of the scale appear as ticks} \item{guide}{A function used to create a guide or its name. See diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 6bdc511f13..11e3d64ed9 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -18,7 +18,8 @@ continuous_scale( oob = censor, expand = waiver(), na.value = NA_real_, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "legend", position = "left", call = caller_call(), @@ -120,7 +121,7 @@ expand the scale by 5\% on each side for continuous variables, and by \item{na.value}{Missing values will be replaced with this value.} -\item{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -128,11 +129,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/datetime_scale.Rd b/man/datetime_scale.Rd index 117d04b013..d0a1afeec2 100644 --- a/man/datetime_scale.Rd +++ b/man/datetime_scale.Rd @@ -6,7 +6,8 @@ \usage{ datetime_scale( aesthetics, - trans, + transform, + trans = deprecated(), palette, breaks = pretty_breaks(), minor_breaks = waiver(), @@ -23,6 +24,19 @@ datetime_scale( \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} +\item{transform}{For continuous scales, the name of a transformation object +or the object itself. Built-in transformations include "asn", "atanh", +"boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", +"logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", +"reverse", "sqrt" and "time". + +A transformation object bundles together a transform, its inverse, +and methods for generating breaks and labels. Transformation objects +are defined in the scales package, and are called \verb{transform_}. If +transformations require arguments, you can call them from the scales +package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. +You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} + \item{trans}{For date/time scales, the name of a date/time transformation or the object itself. Built-in transformations include "hms", "date" and "time".} diff --git a/man/fortify-multcomp.Rd b/man/fortify-multcomp.Rd index cb0eb1fb09..a52dec001c 100644 --- a/man/fortify-multcomp.Rd +++ b/man/fortify-multcomp.Rd @@ -42,7 +42,7 @@ fortify(summary(wht)) ggplot(mapping = aes(lhs, estimate)) + geom_linerange(aes(ymin = lwr, ymax = upr), data = CI) + geom_point(aes(size = p), data = summary(wht)) + - scale_size(trans = "reverse") + scale_size(transform = "reverse") cld <- cld(wht) fortify(cld) diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 789a28db3c..d7ca283a92 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -515,7 +515,7 @@ Methods: it has no information with which to calculate its \code{limits}). \item \code{clone()} Returns a copy of the scale that can be trained independently without affecting the original scale. -\item \code{transform()} Transforms a vector of values using \code{self$trans}. +\item \code{transform()} Transforms a vector of values using \code{self$transformation}. This occurs before the \code{Stat} is calculated. \item \code{train()} Update the \code{self$range} of observed (transformed) data values with a vector of (possibly) new values. @@ -538,14 +538,15 @@ accept a data frame, and apply the \code{transform}, \code{train}, and \code{map based on the combination of \code{self$limits} and/or the range of observed values (\code{self$range}). \item \code{get_breaks()} Calculates the final scale breaks in transformed data space -based on on the combination of \code{self$breaks}, \code{self$trans$breaks()} (for +based on on the combination of \code{self$breaks}, \code{self$transformation$breaks()} (for continuous scales), and \code{limits}. Breaks outside of \code{limits} are assigned a value of \code{NA} (continuous scales) or dropped (discrete scales). \item \code{get_labels()} Calculates labels for a given set of (transformed) \code{breaks} based on the combination of \code{self$labels} and \code{breaks}. \item \code{get_breaks_minor()} For continuous scales, calculates the final scale minor breaks in transformed data space based on the rescaled \code{breaks}, the value of \code{self$minor_breaks}, -and the value of \code{self$trans$minor_breaks()}. Discrete scales always return \code{NULL}. +and the value of \code{self$transformation$minor_breaks()}. Discrete scales always return \code{NULL}. +\item \code{get_transformation()} Returns the scale's transformation object. \item \code{make_title()} Hook to modify the title that is calculated during guide construction (for non-position scales) or when the \code{Layout} calculates the x and y labels (position scales). diff --git a/man/guide_axis_logticks.Rd b/man/guide_axis_logticks.Rd index 3b8fcb5478..25c4c91056 100644 --- a/man/guide_axis_logticks.Rd +++ b/man/guide_axis_logticks.Rd @@ -109,7 +109,7 @@ p2 <- ggplot(data.frame(x = rcauchy(1000)), aes(x = x)) + geom_density() + scale_x_continuous( breaks = c(-10^(4:0), 0, 10^(0:4)), - trans = "pseudo_log" + transform = "pseudo_log" ) # The log ticks are mirrored when 0 is included diff --git a/man/scale_binned.Rd b/man/scale_binned.Rd index 0046d8fbcd..1d9bf4bc58 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -17,7 +17,8 @@ scale_x_binned( na.value = NA_real_, right = TRUE, show.limits = FALSE, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = waiver(), position = "bottom" ) @@ -34,7 +35,8 @@ scale_y_binned( na.value = NA_real_, right = TRUE, show.limits = FALSE, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = waiver(), position = "left" ) @@ -118,7 +120,7 @@ the left (open on the right).} \item{show.limits}{should the limits of the scale appear as ticks} -\item{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -126,11 +128,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_continuous.Rd b/man/scale_continuous.Rd index da226139d7..576e463abb 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -21,7 +21,8 @@ scale_x_continuous( expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = waiver(), position = "bottom", sec.axis = waiver() @@ -37,7 +38,8 @@ scale_y_continuous( expand = waiver(), oob = censor, na.value = NA_real_, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = waiver(), position = "left", sec.axis = waiver() @@ -134,7 +136,7 @@ bounds values with \code{NA}. \item{na.value}{Missing values will be replaced with this value.} -\item{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -142,11 +144,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} @@ -160,7 +165,7 @@ You can create your own transformation with \code{\link[scales:new_transform]{sc \description{ \code{scale_x_continuous()} and \code{scale_y_continuous()} are the default scales for continuous x and y aesthetics. There are three variants -that set the \code{trans} argument for commonly used transformations: +that set the \code{transform} argument for commonly used transformations: \verb{scale_*_log10()}, \verb{scale_*_sqrt()} and \verb{scale_*_reverse()}. } \details{ @@ -217,7 +222,7 @@ p1 + scale_y_sqrt() p1 + scale_y_reverse() # Or you can supply a transformation in the `trans` argument: -p1 + scale_y_continuous(trans = scales::transform_reciprocal()) +p1 + scale_y_continuous(transform = scales::transform_reciprocal()) # You can also create your own. See ?scales::new_transform diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 379476681b..657ef6e60a 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -161,7 +161,7 @@ bounds values with \code{NA}. \item \code{\link[scales:oob]{scales::squish()}} for squishing out of bounds values into range. \item \code{\link[scales:oob]{scales::squish_infinite()}} for squishing infinite values into range. }} - \item{\code{trans}}{For continuous scales, the name of a transformation object + \item{\code{transform}}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -169,10 +169,12 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} + \item{\code{trans}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} \item{\code{expand}}{For position scales, a vector of range expansion constants used to add some padding around the data to ensure that they are placed some distance away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} diff --git a/man/scale_linewidth.Rd b/man/scale_linewidth.Rd index e699c24441..68cd760927 100644 --- a/man/scale_linewidth.Rd +++ b/man/scale_linewidth.Rd @@ -16,7 +16,8 @@ scale_linewidth( labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "legend" ) @@ -28,7 +29,8 @@ scale_linewidth_binned( range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "bins" ) } @@ -77,7 +79,7 @@ If the purpose is to zoom, use the limit argument in the coordinate system \item{range}{a numeric vector of length 2 that specifies the minimum and maximum size of the plotting symbol after transformation.} -\item{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -85,11 +87,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_size.Rd b/man/scale_size.Rd index d8b92414c7..c04338735c 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -19,7 +19,8 @@ scale_size( labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "legend" ) @@ -29,7 +30,8 @@ scale_radius( labels = waiver(), limits = NULL, range = c(1, 6), - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "legend" ) @@ -41,7 +43,8 @@ scale_size_binned( range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, - trans = "identity", + transform = "identity", + trans = deprecated(), guide = "bins" ) @@ -94,7 +97,7 @@ If the purpose is to zoom, use the limit argument in the coordinate system \item{range}{a numeric vector of length 2 that specifies the minimum and maximum size of the plotting symbol after transformation.} -\item{trans}{For continuous scales, the name of a transformation object +\item{transform}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -102,11 +105,14 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} + \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd index a7906d8c4a..e8aab0a473 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -142,7 +142,7 @@ bounds values with \code{NA}. \item \code{\link[scales:oob]{scales::squish()}} for squishing out of bounds values into range. \item \code{\link[scales:oob]{scales::squish_infinite()}} for squishing infinite values into range. }} - \item{\code{trans}}{For continuous scales, the name of a transformation object + \item{\code{transform}}{For continuous scales, the name of a transformation object or the object itself. Built-in transformations include "asn", "atanh", "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", @@ -150,10 +150,12 @@ or the object itself. Built-in transformations include "asn", "atanh", A transformation object bundles together a transform, its inverse, and methods for generating breaks and labels. Transformation objects -are defined in the scales package, and are called \verb{_trans}. If +are defined in the scales package, and are called \verb{transform_}. If transformations require arguments, you can call them from the scales package, e.g. \code{\link[scales:transform_boxcox]{scales::transform_boxcox(p = 2)}}. You can create your own transformation with \code{\link[scales:new_transform]{scales::new_transform()}}.} + \item{\code{trans}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Deprecated in favour of +\code{transform}.} \item{\code{expand}}{For position scales, a vector of range expansion constants used to add some padding around the data to ensure that they are placed some distance away from the axes. Use the convenience function \code{\link[=expansion]{expansion()}} diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd index df69ba8e65..bca906a079 100644 --- a/man/sec_axis.Rd +++ b/man/sec_axis.Rd @@ -7,15 +7,17 @@ \title{Specify a secondary axis} \usage{ sec_axis( - trans = NULL, + transform = NULL, name = waiver(), breaks = waiver(), labels = waiver(), - guide = waiver() + guide = waiver(), + trans = deprecated() ) dup_axis( - trans = ~., + transform = ~., + trans = deprecated(), name = derive(), breaks = derive(), labels = derive(), @@ -25,7 +27,7 @@ dup_axis( derive() } \arguments{ -\item{trans}{A formula or function of transformation} +\item{transform}{A formula or function of transformation} \item{name}{The name of the secondary axis} @@ -47,6 +49,8 @@ derive() \item{guide}{A position guide that will be used to render the axis on the plot. Usually this is \code{\link[=guide_axis]{guide_axis()}}.} + +\item{trans}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} } \description{ This function is used in conjunction with a position scale to create a diff --git a/tests/testthat/test-coord-transform.R b/tests/testthat/test-coord-transform.R index 1f58bdd5fe..abb05a3cae 100644 --- a/tests/testthat/test-coord-transform.R +++ b/tests/testthat/test-coord-transform.R @@ -113,7 +113,7 @@ test_that("second axes display in coord_trans()", { geom_point() + scale_y_continuous( sec.axis = sec_axis( - trans = ~log2(.), + transform = ~log2(.), breaks = c(3.5, 4, 4.5, 5, 5.5), name = "log2(hwy)" ), diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 1614da03ea..e258a5a7ed 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -353,8 +353,8 @@ test_that("legend directions are set correctly", { test_that("guide_axis_logticks calculates appropriate ticks", { - test_scale <- function(trans = transform_identity(), limits = c(NA, NA)) { - scale <- scale_x_continuous(trans = trans) + test_scale <- function(transform = transform_identity(), limits = c(NA, NA)) { + scale <- scale_x_continuous(transform = transform) scale$train(scale$transform(limits)) view_scale_primary(scale) } @@ -662,8 +662,10 @@ test_that("logticks look as they should", { p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + geom_point() + - scale_y_continuous(trans = transform_compose(transform_log10(), transform_reverse()), - expand = expansion(add = 0.5)) + + scale_y_continuous( + transform = transform_compose(transform_log10(), transform_reverse()), + expand = expansion(add = 0.5) + ) + scale_x_continuous( breaks = c(-100, -10, -1, 0, 1, 10, 100) ) + diff --git a/tests/testthat/test-plot-summary-api.R b/tests/testthat/test-plot-summary-api.R index 2d45e990e7..9c2b483eb7 100644 --- a/tests/testthat/test-plot-summary-api.R +++ b/tests/testthat/test-plot-summary-api.R @@ -80,17 +80,17 @@ test_that("layout summary - reversed scales", { lr <- summarise_layout(ggplot_build(pr)) expect_equal(lr$xmin, -7.27) expect_equal(lr$xmax, -1.33) - expect_equal(lr$xscale[[1]]$trans$name, "reverse") - expect_equal(lr$xscale[[1]]$trans$transform(5), -5) + expect_equal(lr$xscale[[1]]$transformation$name, "reverse") + expect_equal(lr$xscale[[1]]$transformation$transform(5), -5) }) test_that("layout summary - log scales", { - pl <- p + scale_x_log10() + scale_y_continuous(trans = "log2") + pl <- p + scale_x_log10() + scale_y_continuous(transform = "log2") ll <- summarise_layout(ggplot_build(pl)) - expect_equal(ll$xscale[[1]]$trans$name, "log-10") - expect_equal(ll$xscale[[1]]$trans$transform(100), 2) - expect_equal(ll$yscale[[1]]$trans$name, "log-2") - expect_equal(ll$yscale[[1]]$trans$transform(16), 4) + expect_equal(ll$xscale[[1]]$transformation$name, "log-10") + expect_equal(ll$xscale[[1]]$transformation$transform(100), 2) + expect_equal(ll$yscale[[1]]$transformation$name, "log-2") + expect_equal(ll$yscale[[1]]$transformation$transform(16), 4) }) test_that("coord summary - basic", { diff --git a/tests/testthat/test-scale-binned.R b/tests/testthat/test-scale-binned.R index af11caf879..e252ef9a72 100644 --- a/tests/testthat/test-scale-binned.R +++ b/tests/testthat/test-scale-binned.R @@ -54,7 +54,7 @@ test_that("binned scales can use NAs in limits", { }) test_that("binned scales can calculate breaks with reverse transformation", { - scale <- scale_x_binned(trans = "reverse") + scale <- scale_x_binned(transform = "reverse") scale$train(c(1, 9)) expect_equal(scale$get_breaks(), 8:2) }) @@ -63,9 +63,9 @@ test_that('binned scales can calculate breaks on dates', { data <- seq(as.Date("2000-01-01"), as.Date("2020-01-01"), length.out = 100) - scale <- scale_x_binned(trans = "date") + scale <- scale_x_binned(transform = "date") scale$train(scale$transform(data)) - breaks <- scale$trans$inverse(scale$get_breaks()) + breaks <- scale$transformation$inverse(scale$get_breaks()) expect_s3_class(breaks, "Date") expect_equal( @@ -81,9 +81,9 @@ test_that('binned scales can calculate breaks on date-times', { length.out = 100 ) - scale <- scale_x_binned(trans = "time") + scale <- scale_x_binned(transform = "time") scale$train(scale$transform(data)) - breaks <- scale$trans$inverse(scale$get_breaks()) + breaks <- scale$transformation$inverse(scale$get_breaks()) expect_s3_class(breaks, "POSIXct") expect_equal( diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index a83ed63498..49f86136fc 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -115,7 +115,7 @@ test_that("discrete labels match breaks", { }) test_that("scale breaks work with numeric log transformation", { - sc <- scale_x_continuous(limits = c(1, 1e5), trans = transform_log10()) + sc <- scale_x_continuous(limits = c(1, 1e5), transform = transform_log10()) expect_equal(sc$get_breaks(), c(0, 2, 4)) # 1, 100, 10000 expect_equal(sc$get_breaks_minor(), c(0, 1, 2, 3, 4, 5)) }) @@ -229,14 +229,14 @@ test_that("breaks can be specified by names of labels", { }) test_that("only finite or NA values for breaks for transformed scales (#871)", { - sc <- scale_y_continuous(limits = c(0.01, 0.99), trans = "probit", + sc <- scale_y_continuous(limits = c(0.01, 0.99), transform = "probit", breaks = seq(0, 1, 0.2)) breaks <- sc$break_info()$major_source expect_true(all(is.finite(breaks) | is.na(breaks))) }) test_that("minor breaks are transformed by scales", { - sc <- scale_y_continuous(limits = c(1, 100), trans = "log10", + sc <- scale_y_continuous(limits = c(1, 100), transform = "log10", minor_breaks = c(1, 10, 100)) expect_equal(sc$get_breaks_minor(), c(0, 1, 2)) @@ -297,15 +297,15 @@ test_that("minor breaks draw correctly", { expect_doppelganger("numeric-log", ggplot(df, aes(x_log, x_log)) + - scale_x_continuous(trans = transform_log2()) + + scale_x_continuous(transform = transform_log2()) + scale_y_log10() + labs(x = NULL, y = NULL) + theme ) expect_doppelganger("numeric-exp", ggplot(df, aes(x_num, x_num)) + - scale_x_continuous(trans = transform_exp(2)) + - scale_y_continuous(trans = transform_exp(2)) + + scale_x_continuous(transform = transform_exp(2)) + + scale_y_continuous(transform = transform_exp(2)) + labs(x = NULL, y = NULL) + theme ) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 70d5b7dd27..4893caceb4 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -460,11 +460,11 @@ test_that("staged aesthetics are backtransformed properly (#4155)", { test_that("numeric scale transforms can produce breaks", { - test_breaks <- function(trans, limits) { - scale <- scale_x_continuous(trans = trans) + test_breaks <- function(transform, limits) { + scale <- scale_x_continuous(transform = transform) scale$train(scale$transform(limits)) view <- view_scale_primary(scale) - scale$trans$inverse(view$get_breaks()) + scale$transformation$inverse(view$get_breaks()) } expect_equal(test_breaks("asn", limits = c(0, 1)), @@ -650,27 +650,27 @@ test_that("scale functions accurately report their calls", { test_that("scale call is found accurately", { - call_template <- quote(scale_x_continuous(trans = "log10")) + call_template <- quote(scale_x_continuous(transform = "log10")) - sc <- do.call("scale_x_continuous", list(trans = "log10")) + sc <- do.call("scale_x_continuous", list(transform = "log10")) expect_equal(sc$call, call_template) - sc <- inject(scale_x_continuous(!!!list(trans = "log10"))) + sc <- inject(scale_x_continuous(!!!list(transform = "log10"))) expect_equal(sc$call, call_template) - sc <- exec("scale_x_continuous", trans = "log10") + sc <- exec("scale_x_continuous", transform = "log10") expect_equal(sc$call, call_template) - foo <- function() scale_x_continuous(trans = "log10") + foo <- function() scale_x_continuous(transform = "log10") expect_equal(foo()$call, call_template) env <- new_environment() - env$bar <- function() scale_x_continuous(trans = "log10") + env$bar <- function() scale_x_continuous(transform = "log10") expect_equal(env$bar()$call, call_template) # Now should recognise the outer function scale_x_new <- function() { - scale_x_continuous(trans = "log10") + scale_x_continuous(transform = "log10") } expect_equal( scale_x_new()$call, diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index 7dcba15139..bcef0ae7aa 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -127,7 +127,7 @@ test_that("custom breaks work", { scale_x_continuous( name = "Unit A", sec.axis = sec_axis( - trans = y ~ ., + transform = y ~ ., breaks = custom_breaks ) ) @@ -142,7 +142,7 @@ test_that("sec axis works with skewed transform", { ggplot(foo, aes(x, y)) + geom_point() + scale_x_continuous( - name = "Unit A", trans = "log", + name = "Unit A", transform = "log", breaks = c(0.001, 0.01, 0.1, 1, 10, 100, 1000), sec.axis = sec_axis(~ . * 100, name = "Unit B", @@ -192,7 +192,7 @@ test_that("sec_axis() handles secondary power transformations", { ) p <- ggplot(df, aes(x, y)) + geom_point() + - scale_y_continuous(sec.axis = sec_axis(trans = (~ 2^.))) + scale_y_continuous(sec.axis = sec_axis(transform = (~ 2^.))) scale <- layer_scales(p)$y breaks <- scale$break_info() @@ -244,11 +244,11 @@ test_that("sec_axis() respects custom transformations", { ggplot(dat, aes(x = x, y = y)) + geom_line(linewidth = 1, na.rm = T) + scale_y_continuous( - trans = + transform = magnify_trans_log(interval_low = 0.5, interval_high = 1, reducer = 0.5, reducer2 = 8), breaks = c(0.001, 0.01, 0.1, 0.5, 0.6, 0.7, 0.8, 0.9, 1), limits = c(0.001, 1), sec.axis = sec_axis( - trans = + transform = ~ . * (1 / 2), breaks = c(0.001, 0.01, 0.1, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5) ) ) + theme_linedraw() @@ -335,8 +335,8 @@ test_that("sec.axis allows independent trans btwn primary and secondary axes", { "sec_axis, independent transformations", ggplot(data = data, aes(Probability, Value)) + geom_point() + scale_x_continuous( - trans = scales::transform_probability(distribution = "norm", lower.tail = FALSE), - sec.axis = sec_axis(trans = ~ 1 / ., name = "Return Period") + transform = scales::transform_probability(distribution = "norm", lower.tail = FALSE), + sec.axis = sec_axis(transform = ~ 1 / ., name = "Return Period") ) + theme_linedraw() ) }) @@ -351,7 +351,8 @@ test_that("sec_axis() works for power transformations (monotonicity test doesn't "sec axis monotonicity test", ggplot(data, aes(x, y)) + geom_line() + - scale_y_continuous(trans = "sqrt", sec.axis = dup_axis()) + theme_linedraw() + scale_y_continuous(transform = "sqrt", sec.axis = dup_axis()) + + theme_linedraw() ) testdat <- data_frame( @@ -360,7 +361,7 @@ test_that("sec_axis() works for power transformations (monotonicity test doesn't ) p <- ggplot(data = testdat, aes(x = x, y = y)) + geom_point() + - scale_y_continuous(sec.axis = sec_axis(trans = ~ .^0.5)) + scale_y_continuous(sec.axis = sec_axis(transform = ~ .^0.5)) scale <- layer_scales(p)$y breaks <- scale$break_info() expect_equal(breaks$major, sqrt(breaks$sec.major), tolerance = .005) diff --git a/vignettes/extending-ggplot2.Rmd b/vignettes/extending-ggplot2.Rmd index 0b856abe72..2f32ae4b68 100644 --- a/vignettes/extending-ggplot2.Rmd +++ b/vignettes/extending-ggplot2.Rmd @@ -864,7 +864,7 @@ FacetTrans <- ggproto("FacetTrans", Facet, if (!is.null(y_scale)) { y_scale_orig <- y_scale$clone() y_scale_new <- y_scale$clone() - y_scale_new$trans <- params$trans + y_scale_new$transformation <- params$trans # Make sure that oob values are kept y_scale_new$oob <- function(x, ...) x scales$y <- list(y_scale_orig, y_scale_new)