From d21ac51dcb13e21bdbed1c2ee00238e190d4d40a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 18:53:36 +0200 Subject: [PATCH 1/9] Integers as valid input to theme (#5370) * Theme accepts integers * Add test * Add news bullet --- NEWS.md | 3 +++ R/theme-elements.R | 12 ++++++------ tests/testthat/_snaps/labels.md | 2 +- tests/testthat/_snaps/theme.md | 4 ++++ tests/testthat/test-theme.R | 7 +++++++ 5 files changed, 21 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6fb136dcfc..9d40a25ffe 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* Integers are once again valid input to theme arguments that expect numeric + input (@teunbrand, #5369) + * Nicer error messages for xlim/ylim arguments in coord-* functions (@92amartins, #4601, #5297). diff --git a/R/theme-elements.R b/R/theme-elements.R index ab8624a761..9d2899b1ea 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -476,12 +476,12 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key.height = el_def("unit", "legend.key.size"), legend.key.width = el_def("unit", "legend.key.size"), legend.text = el_def("element_text", "text"), - legend.text.align = el_def("numeric"), + legend.text.align = el_def(c("numeric", "integer")), legend.title = el_def("element_text", "title"), - legend.title.align = el_def("numeric"), - legend.position = el_def(c("character", "numeric")), + legend.title.align = el_def(c("numeric", "integer")), + legend.position = el_def(c("character", "numeric", "integer")), legend.direction = el_def("character"), - legend.justification = el_def(c("character", "numeric")), + legend.justification = el_def(c("character", "numeric", "integer")), legend.box = el_def("character"), legend.box.just = el_def("character"), legend.box.margin = el_def("margin"), @@ -522,11 +522,11 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { plot.caption = el_def("element_text", "title"), plot.caption.position = el_def("character"), plot.tag = el_def("element_text", "title"), - plot.tag.position = el_def(c("character", "numeric")), # Need to also accept numbers + plot.tag.position = el_def(c("character", "numeric", "integer")), # Need to also accept numbers plot.tag.location = el_def("character"), plot.margin = el_def("margin"), - aspect.ratio = el_def("numeric") + aspect.ratio = el_def(c("numeric", "integer")) ) # Check that an element object has the proper class diff --git a/tests/testthat/_snaps/labels.md b/tests/testthat/_snaps/labels.md index 350e19315f..8c027dae53 100644 --- a/tests/testthat/_snaps/labels.md +++ b/tests/testthat/_snaps/labels.md @@ -1,6 +1,6 @@ # plot.tag.position rejects invalid input - The `plot.tag.position` theme element must be a object. + The `plot.tag.position` theme element must be a object. --- diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index b0f60cd35a..af1b3d4744 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -53,3 +53,7 @@ `plot.tag.position` must be one of "topleft", "top", "topright", "left", "right", "bottomleft", "bottom", or "bottomright", not "test". i Did you mean "left"? +# Theme validation behaves as expected + + The `aspect.ratio` theme element must be a object. + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 9973f1128d..2ae6a2bef4 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -492,6 +492,13 @@ test_that("Theme elements are checked during build", { expect_snapshot_error(ggplotGrob(p)) }) +test_that("Theme validation behaves as expected", { + tree <- get_element_tree() + expect_silent(validate_element(1, "aspect.ratio", tree)) + expect_silent(validate_element(1L, "aspect.ratio", tree)) + expect_snapshot_error(validate_element("A", "aspect.ratio", tree)) +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", { From af4cc02e1ed47ce7c0b1c37ce9cbdd65f8c0ab48 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 18:54:39 +0200 Subject: [PATCH 2/9] Passing parameters to `trans` argument (#5361) --- R/scale-.R | 7 ++++--- man/binned_scale.Rd | 7 ++++--- man/continuous_scale.Rd | 7 ++++--- man/scale_binned.Rd | 7 ++++--- man/scale_continuous.Rd | 7 ++++--- man/scale_gradient.Rd | 7 ++++--- man/scale_linewidth.Rd | 7 ++++--- man/scale_size.Rd | 7 ++++--- man/scale_steps.Rd | 7 ++++--- 9 files changed, 36 insertions(+), 27 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index 97e2e8378e..d627e88498 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -73,9 +73,10 @@ #' #' 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` (e.g., -#' [scales::boxcox_trans()]). You can create your own -#' transformation with [scales::trans_new()]. +#' 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()]. #' @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 diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 40cd372207..6a64eb36d7 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -127,9 +127,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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 da41b1ee4e..677091357e 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -125,9 +125,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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_binned.Rd b/man/scale_binned.Rd index 0a729d0c6a..7949c45f13 100644 --- a/man/scale_binned.Rd +++ b/man/scale_binned.Rd @@ -126,9 +126,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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 554e96f69e..f145e8c18a 100644 --- a/man/scale_continuous.Rd +++ b/man/scale_continuous.Rd @@ -140,9 +140,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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_gradient.Rd b/man/scale_gradient.Rd index a7e45e30cb..53dfc30a16 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -167,9 +167,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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 b661926b3a..153ac04fdf 100644 --- a/man/scale_linewidth.Rd +++ b/man/scale_linewidth.Rd @@ -85,9 +85,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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 c80df3bcb3..304ceafa56 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -102,9 +102,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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 7344adbb2c..3dcad65e49 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -150,9 +150,10 @@ 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} (e.g., -\code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}). You can create your own -transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} +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()}}.} \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()}} From a747da370e9c7ebf04f16a2314fdd7ed03187dc5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 19:54:05 +0200 Subject: [PATCH 3/9] Deprecate `legend.title.align` and `legend.text.align` (#5362) * soft-deprecate `legend.text/title.align` * Remove `legend.text/title.align` from element tree * Absolve default themes * Absolve guides * Don't recommend `legend.title.align` * Add news bullet --- NEWS.md | 5 ++++ R/guide-colorbar.R | 4 +--- R/guide-legend.R | 10 +++----- R/theme-defaults.R | 4 ---- R/theme-elements.R | 2 -- R/theme.R | 32 +++++++++++++++++++++----- man/theme.Rd | 8 ------- vignettes/articles/faq-customising.Rmd | 6 ++--- 8 files changed, 38 insertions(+), 33 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9d40a25ffe..096ac629a0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,13 @@ # ggplot2 (development version) +* The `legend.text.align` and `legend.title.align` arguments in `theme()` are + deprecated. The `hjust` setting of the `legend.text` and `legend.title` + elements continues to fulfil the role of text alignment (@teunbrand, #5347). + * Integers are once again valid input to theme arguments that expect numeric input (@teunbrand, #5369) + * Nicer error messages for xlim/ylim arguments in coord-* functions (@92amartins, #4601, #5297). diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 65291f37cc..b7ffdb9abf 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -314,9 +314,7 @@ GuideColourbar <- ggproto( key.height = "legend.key.height", key.width = "legend.key.width", text = "legend.text", - text.align = "legend.text.align", - theme.title = "legend.title", - title.align = "legend.title.align" + theme.title = "legend.title" ), extract_decor = function(scale, aesthetic, nbin = 300, reverse = FALSE, ...) { diff --git a/R/guide-legend.R b/R/guide-legend.R index 0e6193aa24..2ac35f05b8 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -256,9 +256,7 @@ GuideLegend <- ggproto( key.height = "legend.key.height", key.width = "legend.key.width", text = "legend.text", - text.align = "legend.text.align", - theme.title = "legend.title", - title.align = "legend.title.align" + theme.title = "legend.title" ), extract_params = function(scale, params, hashables, @@ -395,8 +393,7 @@ GuideLegend <- ggproto( # Title title <- combine_elements(params$title.theme, elements$theme.title) - title$hjust <- params$title.hjust %||% elements$title.align %||% - title$hjust %||% 0 + title$hjust <- params$title.hjust %||% title$hjust %||% 0 title$vjust <- params$title.vjust %||% title$vjust %||% 0.5 elements$title <- title @@ -421,8 +418,7 @@ GuideLegend <- ggproto( is.null(theme$legend.text$vjust)) { label$vjust <- NULL } - label$hjust <- params$label.hjust %||% elements$text.align %||% - label$hjust %||% hjust + label$hjust <- params$label.hjust %||% label$hjust %||% hjust label$vjust <- params$label.vjust %||% label$vjust %||% vjust } elements$text <- label diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 5c1018e85f..fd565307bb 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -176,9 +176,7 @@ theme_grey <- function(base_size = 11, base_family = "", legend.key.height = NULL, legend.key.width = NULL, legend.text = element_text(size = rel(0.8)), - legend.text.align = NULL, legend.title = element_text(hjust = 0), - legend.title.align = NULL, legend.position = "right", legend.direction = NULL, legend.justification = "center", @@ -590,9 +588,7 @@ theme_test <- function(base_size = 11, base_family = "", legend.key.height = NULL, legend.key.width = NULL, legend.text = element_text(size = rel(0.8)), - legend.text.align = NULL, legend.title = element_text(hjust = 0), - legend.title.align = NULL, legend.position = "right", legend.direction = NULL, legend.justification = "center", diff --git a/R/theme-elements.R b/R/theme-elements.R index 9d2899b1ea..044df52406 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -476,9 +476,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key.height = el_def("unit", "legend.key.size"), legend.key.width = el_def("unit", "legend.key.size"), legend.text = el_def("element_text", "text"), - legend.text.align = el_def(c("numeric", "integer")), legend.title = el_def("element_text", "title"), - legend.title.align = el_def(c("numeric", "integer")), legend.position = el_def(c("character", "numeric", "integer")), legend.direction = el_def("character"), legend.justification = el_def(c("character", "numeric", "integer")), diff --git a/R/theme.R b/R/theme.R index 086c35174e..2bfdd5a835 100644 --- a/R/theme.R +++ b/R/theme.R @@ -71,12 +71,8 @@ #' `legend.key.size` or can be specified separately #' @param legend.text legend item labels ([element_text()]; inherits from #' `text`) -#' @param legend.text.align alignment of legend labels (number from 0 (left) to -#' 1 (right)) #' @param legend.title title of legend ([element_text()]; inherits from #' `title`) -#' @param legend.title.align alignment of legend title (number from 0 (left) to -#' 1 (right)) #' @param legend.position the position of legends ("none", "left", "right", #' "bottom", "top", or two-element numeric vector) #' @param legend.direction layout of items in legends ("horizontal" or @@ -330,9 +326,7 @@ theme <- function(line, legend.key.height, legend.key.width, legend.text, - legend.text.align, legend.title, - legend.title.align, legend.position, legend.direction, legend.justification, @@ -419,6 +413,32 @@ theme <- function(line, elements$legend.spacing <- elements$legend.margin elements$legend.margin <- margin() } + if (!is.null(elements$legend.title.align)) { + deprecate_soft0( + "3.5.0", "theme(legend.title.align)", + I("theme(legend.title = element_text(hjust))") + ) + if (is.null(elements[["legend.title"]])) { + elements$legend.title <- element_text(hjust = elements$legend.title.align) + } else { + elements$legend.title$hjust <- elements$legend.title$hjust %||% + elements$legend.title.align + } + elements$legend.title.align <- NULL + } + if (!is.null(elements$legend.text.align)) { + deprecate_soft0( + "3.5.0", "theme(legend.text.align)", + I("theme(legend.text = element_text(hjust))") + ) + if (is.null(elements[["legend.text"]])) { + elements$legend.text <- element_text(hjust = elements$legend.text.align) + } else { + elements$legend.text$hjust <- elements$legend.text$hjust %||% + elements$legend.text.align + } + elements$legend.text.align <- NULL + } # If complete theme set all non-blank elements to inherit from blanks if (complete) { diff --git a/man/theme.Rd b/man/theme.Rd index 29cfe9f9b3..e433fe7206 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -55,9 +55,7 @@ theme( legend.key.height, legend.key.width, legend.text, - legend.text.align, legend.title, - legend.title.align, legend.position, legend.direction, legend.justification, @@ -167,15 +165,9 @@ inherits from \code{rect})} \item{legend.text}{legend item labels (\code{\link[=element_text]{element_text()}}; inherits from \code{text})} -\item{legend.text.align}{alignment of legend labels (number from 0 (left) to -1 (right))} - \item{legend.title}{title of legend (\code{\link[=element_text]{element_text()}}; inherits from \code{title})} -\item{legend.title.align}{alignment of legend title (number from 0 (left) to -1 (right))} - \item{legend.position}{the position of legends ("none", "left", "right", "bottom", "top", or two-element numeric vector)} diff --git a/vignettes/articles/faq-customising.Rmd b/vignettes/articles/faq-customising.Rmd index 3ae048e4fd..bf9cbef6d2 100644 --- a/vignettes/articles/faq-customising.Rmd +++ b/vignettes/articles/faq-customising.Rmd @@ -130,7 +130,7 @@ ggplot(mpg, aes(x = hwy, y = cty, color = drv)) + ``` Note that the legend title is no longer aligned with the keys with this approach. -You can also shift it over with `legend.title.align`. +You can also shift it over with the `hjust` setting of `legend.title`. ```{r} #| fig.alt = "A scatter plot showing the highway miles per gallon on the x-axis @@ -143,8 +143,8 @@ ggplot(mpg, aes(x = hwy, y = cty, color = drv)) + theme( legend.key.size = unit(1.5, "cm"), legend.key = element_rect(color = NA, fill = NA), - legend.title.align = 0.5 - ) + legend.title = element_text(hjust = 0.5) + ) ``` From cd7199dcc43318690fc444913033ad74021ae867 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 1 Aug 2023 20:20:29 +0200 Subject: [PATCH 4/9] Binned limits and reverse transform (#5357) * Borrow `get_limits()` method * Consider sort-order of limits * Add tests * Add news bullet --- NEWS.md | 6 +++++- R/scale-.R | 15 +++++++++++++-- tests/testthat/test-scale-binned.R | 15 +++++++++++++++ 3 files changed, 33 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 096ac629a0..b62ba9eba0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* Binned scales now treat `NA`s in limits the same way continuous scales do + (#5355). + +* Binned scales work better with `trans = "reverse"` (#5355). + * The `legend.text.align` and `legend.title.align` arguments in `theme()` are deprecated. The `hjust` setting of the `legend.text` and `legend.title` elements continues to fulfil the role of text alignment (@teunbrand, #5347). @@ -7,7 +12,6 @@ * Integers are once again valid input to theme arguments that expect numeric input (@teunbrand, #5369) - * Nicer error messages for xlim/ylim arguments in coord-* functions (@92amartins, #4601, #5297). diff --git a/R/scale-.R b/R/scale-.R index d627e88498..6c6fbb1c78 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -1057,10 +1057,16 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, expand_range4(self$get_limits(), expand) }, + get_limits = function(self) { + ggproto_parent(ScaleContinuous, self)$get_limits() + }, + get_breaks = function(self, limits = self$get_limits()) { if (self$is_empty()) return(numeric()) limits <- self$trans$inverse(limits) + is_rev <- limits[2] < limits[1] + limits <- sort(limits) if (is.null(self$breaks)) { return(NULL) @@ -1107,7 +1113,11 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } new_limits_trans <- suppressWarnings(self$trans$transform(new_limits)) limits[is.finite(new_limits_trans)] <- new_limits[is.finite(new_limits_trans)] - self$limits <- self$trans$transform(limits) + if (is_rev) { + self$limits <- rev(self$trans$transform(limits)) + } else { + self$limits <- self$trans$transform(limits) + } } } else if (is.function(self$breaks)) { if ("n.breaks" %in% names(formals(environment(self$breaks)$f))) { @@ -1124,7 +1134,8 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, } # Breaks must be within limits - breaks <- breaks[breaks >= limits[1] & breaks <= limits[2]] + breaks <- oob_discard(breaks, sort(limits)) + self$breaks <- breaks self$trans$transform(breaks) diff --git a/tests/testthat/test-scale-binned.R b/tests/testthat/test-scale-binned.R index 5e788547db..af11caf879 100644 --- a/tests/testthat/test-scale-binned.R +++ b/tests/testthat/test-scale-binned.R @@ -44,6 +44,21 @@ test_that("binned limits should not compute out-of-bounds breaks", { )) }) +test_that("binned scales can use NAs in limits", { + scale <- scale_x_binned(limits = c(NA, 10)) + scale$train(c(-20, 20)) + expect_equal(scale$get_limits(), c(-20, 10)) + scale <- scale_x_binned(limits = c(-10, NA)) + scale$train(c(-20, 20)) + expect_equal(scale$get_limits(), c(-10, 20)) +}) + +test_that("binned scales can calculate breaks with reverse transformation", { + scale <- scale_x_binned(trans = "reverse") + scale$train(c(1, 9)) + expect_equal(scale$get_breaks(), 8:2) +}) + test_that('binned scales can calculate breaks on dates', { data <- seq(as.Date("2000-01-01"), as.Date("2020-01-01"), length.out = 100) From 466344ae153947ca0fbcdb73848e527cc89da6a9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 7 Aug 2023 20:10:01 +0200 Subject: [PATCH 5/9] Miscellaneous improvements to guides (#5345) * Handle `labels = NULL` better * Convert `guides()` error to warning * Ignore no guides * Swap old train order * Fix `even.steps`/`show.limits` interaction * Change to soft deprecation * Fix old guide title * Fix `draw_axis()` with `NULL` labels * Default old guide title is `waiver()` * `guide_for_position` becomes method * GuideColoursteps is a named class * `guide_colourbar()` rejects discrete scales * Fix test TODO * Use `vec_slice()` to preserve attributes * Document extension points * Handle hashing in `train()` --- R/coord-cartesian-.R | 36 ++---------- R/guide-.R | 103 ++++++++++++++++++++++++++++++++--- R/guide-axis.R | 23 +++----- R/guide-bins.R | 11 ++-- R/guide-colorbar.R | 19 ++++++- R/guide-colorsteps.R | 8 +-- R/guide-legend.R | 10 +++- R/guide-old.R | 8 +-- R/guides-.R | 39 ++++++++++++- man/ggplot2-ggproto.Rd | 59 +++++++++++++++++++- tests/testthat/test-guides.R | 23 +++++--- 11 files changed, 256 insertions(+), 83 deletions(-) diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R index 7c64ec9744..8451873b84 100644 --- a/R/coord-cartesian-.R +++ b/R/coord-cartesian-.R @@ -147,37 +147,9 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { } panel_guides_grob <- function(guides, position, theme) { - pair <- guide_for_position(guides, position) %||% - list(guide = guide_none(), params = NULL) - pair$guide$draw(theme, pair$params) -} - -guide_for_position <- function(guides, position) { - params <- guides$params - has_position <- vapply( - params, function(p) identical(p$position, position), logical(1) - ) - if (!any(has_position)) { - return(NULL) - } - - # Subset guides and parameters - guides <- guides$get_guide(has_position) - params <- params[has_position] - # Pair up guides with parameters - pairs <- Map(list, guide = guides, params = params) - - # Early exit, nothing to merge - if (length(pairs) == 1) { - return(pairs[[1]]) + if (!inherits(guides, "Guides")) { + return(zeroGrob()) } - - # TODO: There must be a smarter way to merge these - order <- order(vapply(params, function(p) as.numeric(p$order), numeric(1))) - Reduce( - function(old, new) { - old$guide$merge(old$params, new$guide, new$params) - }, - pairs[order] - ) + pair <- guides$get_position(position) + pair$guide$draw(theme, pair$params) } diff --git a/R/guide-.R b/R/guide-.R index b9e2685ff1..ae774d30c9 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -74,7 +74,79 @@ new_guide <- function(..., available_aes = "any", super) { #' To create a new type of Guide object, you typically will want to override #' one or more of the following: #' -#' TODO: Fill this in properly +#' Properties: +#' +#' - `available_aes` A `character` vector with aesthetics that this guide +#' supports. The value `"any"` indicates all non-position aesthetics. +#' +#' - `params` A named `list` of parameters that the guide needs to function. +#' It has the following roles: +#' +#' - `params` provides the defaults for a guide. +#' - `names(params)` determines what are valid arguments to `new_guide()`. +#' Some parameters are *required* to render the guide. These are: `title`, +#' `name`, `position`, `direction`, `order` and `hash`. +#' - During build stages, `params` holds information about the guide. +#' +#' - `elements` A named list of `character`s, giving the name of theme elements +#' that should be retrieved automatically, for example `"legend.text"`. +#' +#' - `hashables` An `expression` that can be evaluated in the context of +#' `params`. The hash of the evaluated expression determines the merge +#' compatibility of guides, and is stored in `params$hash`. +#' +#' Methods: +#' +#' - `extract_key()` Returns a `data.frame` with (mapped) breaks and labels +#' extracted from the scale, which will be stored in `params$key`. +#' +#' - `extract_decor()` Returns a `data.frame` containing other structured +#' information extracted from the scale, which will be stored in +#' `params$decor`. The `decor` has a guide-specific meaning: it is the bar in +#' `guide_colourbar()`, but specifies the `axis.line` in `guide_axis()`. +#' +#' - `extract_params()` Updates the `params` with other, unstructured +#' information from the scale. An example of this is inheriting the guide's +#' title from the `scale$name` field. +#' +#' - `transform()` Updates the `params$key` based on the coordinates. This +#' applies to position guides, as it rescales the aesthetic to the \[0, 1\] +#' range. +#' +#' - `merge()` Combines information from multiple guides with the same +#' `params$hash`. This ensures that e.g. `guide_legend()` can display both +#' `shape` and `colour` in the same guide. +#' +#' - `get_layer_key()` Extract information from layers. This can be used to +#' check that the guide's aesthetic is actually in use, or to gather +#' information about how legend keys should be displayed. +#' +#' - `setup_params()` Set up parameters at the beginning of drawing stages. +#' It can be used to overrule user-supplied parameters or perform checks on +#' the `params` property. +#' +#' - `override_elements()` Take populated theme elements derived from the +#' `elements` property and allows overriding these theme settings. +#' +#' - `build_title()` Render the guide's title. +#' +#' - `build_labels()` Render the guide's labels. +#' +#' - `build_decor()` Render the `params$decor`, which is different for every +#' guide. +#' +#' - `build_ticks()` Render tick marks. +#' +#' - `measure_grobs()` Measure dimensions of the graphical objects produced +#' by the `build_*()` methods to be used in the layout or assembly. +#' +#' - `arrange_layout()` Set up a layout for how graphical objects produced by +#' the `build_*()` methods should be arranged. +#' +#' - `assemble_drawing()` Take the graphical objects produced by the `build_*()` +#' methods, the measurements from `measure_grobs()` and layout from +#' `arrange_layout()` to finalise the guide. +#' #' @rdname ggplot2-ggproto #' @format NULL #' @usage NULL @@ -117,14 +189,15 @@ Guide <- ggproto( return(NULL) } params$decor <- inject(self$extract_decor(scale, !!!params)) - self$extract_params(scale, params, self$hashables, ...) + params <- self$extract_params(scale, params, ...) + # Make hash + # TODO: Maybe we only need the hash on demand during merging? + params$hash <- hash(lapply(unname(self$hashables), eval_tidy, data = params)) + params }, # Setup parameters that are only available after training - # TODO: Maybe we only need the hash on demand during merging? - extract_params = function(scale, params, hashables, ...) { - # Make hash - params$hash <- hash(lapply(unname(hashables), eval_tidy, data = params)) + extract_params = function(scale, params, ...) { params }, @@ -137,13 +210,18 @@ Guide <- ggproto( mapped <- scale$map(breaks) labels <- scale$get_labels(breaks) + # {vctrs} doesn't play nice with expressions, convert to list. + # see also https://github.com/r-lib/vctrs/issues/559 + if (is.expression(labels)) { + labels <- as.list(labels) + } key <- data_frame(mapped, .name_repair = ~ aesthetic) key$.value <- breaks key$.label <- labels if (is.numeric(breaks)) { - key[is.finite(breaks), , drop = FALSE] + vec_slice(key, is.finite(breaks)) } else { key } @@ -342,3 +420,14 @@ flip_names = c( # Shortcut for position argument matching .trbl <- c("top", "right", "bottom", "left") +# Ensure that labels aren't a list of expressions, but proper expressions +validate_labels <- function(labels) { + if (!is.list(labels)) { + return(labels) + } + if (any(vapply(labels, is.language, logical(1)))) { + do.call(expression, labels) + } else { + unlist(labels) + } +} diff --git a/R/guide-axis.R b/R/guide-axis.R index a6ce730476..eac32b2b98 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -103,9 +103,9 @@ GuideAxis <- ggproto( ticks_length = "axis.ticks.length" ), - extract_params = function(scale, params, hashables, ...) { + extract_params = function(scale, params, ...) { params$name <- paste0(params$name, "_", params$aesthetic) - Guide$extract_params(scale, params, hashables) + params }, extract_decor = function(scale, aesthetic, position, key, cap = "none", ...) { @@ -281,22 +281,14 @@ GuideAxis <- ggproto( }, build_labels = function(key, elements, params) { - labels <- key$.label + labels <- validate_labels(key$.label) n_labels <- length(labels) if (n_labels < 1) { return(list(zeroGrob())) } - pos <- key[[params$aes]] - - if (is.list(labels)) { - if (any(vapply(labels, is.language, logical(1)))) { - labels <- do.call(expression, labels) - } else { - labels <- unlist(labels) - } - } + pos <- key[[params$aes]] dodge_pos <- rep(seq_len(params$n.dodge %||% 1), length.out = n_labels) dodge_indices <- unname(split(seq_len(n_labels), dodge_pos)) @@ -432,9 +424,10 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme, aes <- if (axis_position %in% c("top", "bottom")) "x" else "y" opp <- setdiff(c("x", "y"), aes) opp_value <- if (axis_position %in% c("top", "right")) 0 else 1 - key <- data_frame( - break_positions, break_positions, break_labels, - .name_repair = ~ c(aes, ".value", ".label") + key <- data_frame0( + !!aes := break_positions, + .value = break_positions, + .label = break_labels ) params$key <- key params$decor <- data_frame0( diff --git a/R/guide-bins.R b/R/guide-bins.R index bfdd9d0701..63c75bd0bd 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -266,7 +266,7 @@ GuideBins <- ggproto( return(key) }, - extract_params = function(scale, params, hashables, + extract_params = function(scale, params, title = waiver(), direction = NULL, ...) { show.limits <- params$show.limits %||% scale$show.limits %||% FALSE @@ -320,8 +320,7 @@ GuideBins <- ggproto( "not {.val {params$label.position}}." )) } - - Guide$extract_params(scale, params, hashables) + params }, setup_params = function(params) { @@ -340,7 +339,11 @@ GuideBins <- ggproto( }, build_labels = function(key, elements, params) { - key$.label[c(1, nrow(key))[!params$show.limits]] <- "" + n_labels <- length(key$.label) + if (n_labels < 1) { + return(list(labels = zeroGrob())) + } + key$.label[c(1, n_labels)[!params$show.limits]] <- "" just <- if (params$direction == "horizontal") { elements$text$vjust diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index b7ffdb9abf..092b5a35ba 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -317,6 +317,14 @@ GuideColourbar <- ggproto( theme.title = "legend.title" ), + extract_key = function(scale, aesthetic, ...) { + if (scale$is_discrete()) { + cli::cli_warn("{.fn guide_colourbar} needs continuous scales.") + return(NULL) + } + Guide$extract_key(scale, aesthetic, ...) + }, + extract_decor = function(scale, aesthetic, nbin = 300, reverse = FALSE, ...) { limits <- scale$get_limits() @@ -335,7 +343,7 @@ GuideColourbar <- ggproto( return(bar) }, - extract_params = function(scale, params, hashables, + extract_params = function(scale, params, title = waiver(), direction = "vertical", ...) { params$title <- scale$make_title( params$title %|W|% scale$name %|W|% title @@ -364,7 +372,7 @@ GuideColourbar <- ggproto( c(0.5, params$nbin - 0.5) / params$nbin, limits ) - Guide$extract_params(scale, params, hashables) + params }, merge = function(self, params, new_guide, new_params) { @@ -414,6 +422,11 @@ GuideColourbar <- ggproto( }, build_labels = function(key, elements, params) { + n_labels <- length(key$.label) + if (n_labels < 1) { + return(list(labels = zeroGrob())) + } + just <- if (params$direction == "horizontal") { elements$text$vjust } else { @@ -422,7 +435,7 @@ GuideColourbar <- ggproto( list(labels = flip_element_grob( elements$text, - label = key$.label, + label = validate_labels(key$.label), x = unit(key$.value, "npc"), y = rep(just, nrow(key)), margin_x = FALSE, diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R index d964e1d058..e82715c543 100644 --- a/R/guide-colorsteps.R +++ b/R/guide-colorsteps.R @@ -74,7 +74,7 @@ guide_colorsteps <- guide_coloursteps #' @usage NULL #' @export GuideColoursteps <- ggproto( - NULL, GuideColourbar, + "GuideColoursteps", GuideColourbar, params = c( list(even.steps = TRUE, show.limits = NULL), @@ -135,7 +135,7 @@ GuideColoursteps <- ggproto( return(bar) }, - extract_params = function(scale, params, hashables, ...) { + extract_params = function(scale, params, ...) { if (params$even.steps) { params$nbin <- nbin <- sum(!is.na(params$key[[1]])) + 1 @@ -164,7 +164,7 @@ GuideColoursteps <- ggproto( from = c(0.5, nbin - 0.5) / nbin ) key <- params$key - limits <- attr(key, "limits", TRUE) + limits <- attr(key, "limits", TRUE) %||% scale$get_limits() key <- key[c(NA, seq_len(nrow(key)), NA), , drop = FALSE] key$.value[c(1, nrow(key))] <- edges key$.label[c(1, nrow(key))] <- scale$get_labels(limits) @@ -177,6 +177,6 @@ GuideColoursteps <- ggproto( params$key <- key } - GuideColourbar$extract_params(scale, params, hashables, ...) + GuideColourbar$extract_params(scale, params, ...) } ) diff --git a/R/guide-legend.R b/R/guide-legend.R index 2ac35f05b8..b80062d618 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -259,7 +259,7 @@ GuideLegend <- ggproto( theme.title = "legend.title" ), - extract_params = function(scale, params, hashables, + extract_params = function(scale, params, title = waiver(), direction = NULL, ...) { params$title <- scale$make_title( params$title %|W|% scale$name %|W|% title @@ -271,8 +271,7 @@ GuideLegend <- ggproto( if (isTRUE(params$reverse %||% FALSE)) { params$key <- params$key[nrow(params$key):1, , drop = FALSE] } - - Guide$extract_params(scale, params, hashables) + params }, merge = function(self, params, new_guide, new_params) { @@ -476,6 +475,11 @@ GuideLegend <- ggproto( }, build_labels = function(key, elements, params) { + n_labels <- length(key$.label) + if (n_labels < 1) { + out <- rep(list(zeroGrob()), nrow(key)) + return(out) + } lapply(key$.label, function(lab) { ggname( "guide.label", diff --git a/R/guide-old.R b/R/guide-old.R index 735dc96f21..2320b0bbf2 100644 --- a/R/guide-old.R +++ b/R/guide-old.R @@ -65,7 +65,7 @@ guide_gengrob.default <- guide_train.default #' @export #' @rdname old_guide old_guide <- function(guide) { - deprecate_warn0( + deprecate_soft0( when = "3.5.0", what = I("The S3 guide system"), details = c( @@ -88,10 +88,10 @@ GuideOld <- ggproto( "GuideOld", Guide, train = function(self, params, scale, aesthetic = NULL, - title = NULL, direction = NULL) { - params <- guide_train(params, scale, aesthetic) - params$title <- params$title %|W|% title + title = waiver(), direction = NULL) { + params$title <- scale$make_title(params$title %|W|% scale$name %|W|% title) params$direction <- params$direction %||% direction + params <- guide_train(params, scale, aesthetic) params }, diff --git a/R/guides-.R b/R/guides-.R index f8273d07e6..163559b99c 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -84,7 +84,12 @@ guides <- function(...) { return(guides_list(guides = args)) } - # Raise error about unnamed guides + # If there are no guides, do nothing + if (length(args) == 0) { + return(NULL) + } + + # Raise warning about unnamed guides nms <- names(args) if (is.null(nms)) { msg <- "All guides are unnamed." @@ -97,10 +102,11 @@ guides <- function(...) { msg <- "The {.and {unnamed}} guide{?s} {?is/are} unnamed." } } - cli::cli_abort(c( + cli::cli_warn(c( "Guides provided to {.fun guides} must be named.", i = msg )) + NULL } update_guides <- function(p, guides) { @@ -213,6 +219,35 @@ Guides <- ggproto( } }, + get_position = function(self, position) { + check_string("position") + + guide_positions <- lapply(self$params, `[[`, "position") + idx <- which(vapply(guide_positions, identical, logical(1), y = position)) + + if (length(idx) < 1) { + # No guide found for position, return missing (guide_none) guide + return(list(guide = self$missing, params = self$missing$params)) + } + if (length(idx) == 1) { + # Happy path when nothing needs to merge + return(list(guide = self$guides[[idx]], params = self$params[[idx]])) + } + + # Pair up guides and parameters + params <- self$params[idx] + pairs <- Map(list, guide = self$guides[idx], params = params) + + # Merge pairs sequentially + order <- order(vapply(params, function(p) as.numeric(p$order), numeric(1))) + Reduce( + function(old, new) { + old$guide$merge(old$params, new$guide, new$params) + }, + pairs[order] + ) + }, + ## Building ------------------------------------------------------------------ # The `Guides$build()` method is called in ggplotGrob (plot-build.R) and makes diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index a74d8877e8..37a042dd68 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -384,7 +384,64 @@ top-level \code{Guide}, and each implements their own methods for drawing. To create a new type of Guide object, you typically will want to override one or more of the following: -TODO: Fill this in properly +Properties: +\itemize{ +\item \code{available_aes} A \code{character} vector with aesthetics that this guide +supports. The value \code{"any"} indicates all non-position aesthetics. +\item \code{params} A named \code{list} of parameters that the guide needs to function. +It has the following roles: +\itemize{ +\item \code{params} provides the defaults for a guide. +\item \code{names(params)} determines what are valid arguments to \code{new_guide()}. +Some parameters are \emph{required} to render the guide. These are: \code{title}, +\code{name}, \code{position}, \code{direction}, \code{order} and \code{hash}. +\item During build stages, \code{params} holds information about the guide. +} +\item \code{elements} A named list of \code{character}s, giving the name of theme elements +that should be retrieved automatically, for example \code{"legend.text"}. +\item \code{hashables} An \code{expression} that can be evaluated in the context of +\code{params}. The hash of the evaluated expression determines the merge +compatibility of guides, and is stored in \code{params$hash}. +} + +Methods: +\itemize{ +\item \code{extract_key()} Returns a \code{data.frame} with (mapped) breaks and labels +extracted from the scale, which will be stored in \code{params$key}. +\item \code{extract_decor()} Returns a \code{data.frame} containing other structured +information extracted from the scale, which will be stored in +\code{params$decor}. The \code{decor} has a guide-specific meaning: it is the bar in +\code{guide_colourbar()}, but specifies the \code{axis.line} in \code{guide_axis()}. +\item \code{extract_params()} Updates the \code{params} with other, unstructured +information from the scale. An example of this is inheriting the guide's +title from the \code{scale$name} field. +\item \code{transform()} Updates the \code{params$key} based on the coordinates. This +applies to position guides, as it rescales the aesthetic to the [0, 1] +range. +\item \code{merge()} Combines information from multiple guides with the same +\code{params$hash}. This ensures that e.g. \code{guide_legend()} can display both +\code{shape} and \code{colour} in the same guide. +\item \code{get_layer_key()} Extract information from layers. This can be used to +check that the guide's aesthetic is actually in use, or to gather +information about how legend keys should be displayed. +\item \code{setup_params()} Set up parameters at the beginning of drawing stages. +It can be used to overrule user-supplied parameters or perform checks on +the \code{params} property. +\item \code{override_elements()} Take populated theme elements derived from the +\code{elements} property and allows overriding these theme settings. +\item \code{build_title()} Render the guide's title. +\item \code{build_labels()} Render the guide's labels. +\item \code{build_decor()} Render the \code{params$decor}, which is different for every +guide. +\item \code{build_ticks()} Render tick marks. +\item \code{measure_grobs()} Measure dimensions of the graphical objects produced +by the \verb{build_*()} methods to be used in the layout or assembly. +\item \code{arrange_layout()} Set up a layout for how graphical objects produced by +the \verb{build_*()} methods should be arranged. +\item \code{assemble_drawing()} Take the graphical objects produced by the \verb{build_*()} +methods, the measurements from \code{measure_grobs()} and layout from +\code{arrange_layout()} to finalise the guide. +} } \section{Positions}{ diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 4ef7174f99..ce111a2fcc 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -128,11 +128,7 @@ test_that("a warning is generated when more than one position guide is drawn at ) built <- expect_silent(ggplot_build(plot)) - # TODO: These multiple warnings should be summarized nicely. Until this gets - # fixed, this test ignores all the following errors than the first one. - suppressWarnings( - expect_warning(ggplot_gtable(built), "Discarding guide") - ) + expect_warning(ggplot_gtable(built), "Discarding guide") }) test_that("a warning is not generated when properly changing the position of a guide_axis()", { @@ -311,6 +307,16 @@ test_that("guide_coloursteps and guide_bins return ordered breaks", { expect_true(all(diff(key$.value) < 0)) }) +test_that("guide_colourbar warns about discrete scales", { + + g <- guide_colourbar() + s <- scale_colour_discrete() + s$train(LETTERS[1:3]) + + expect_warning(g <- g$train(g$params, s, "colour"), "needs continuous scales") + expect_null(g) +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -760,15 +766,16 @@ test_that("a warning is generated when guides( = FALSE) is specified", { expect_snapshot_warning(ggplot_gtable(built)) }) -test_that("guides() errors if unnamed guides are provided", { - expect_error( +test_that("guides() warns if unnamed guides are provided", { + expect_warning( guides("axis"), "All guides are unnamed." ) - expect_error( + expect_warning( guides(x = "axis", "axis"), "The 2nd guide is unnamed" ) + expect_null(guides()) }) test_that("old S3 guides can be implemented", { From df1b901b15439a670dbf38e668c16094e867b01f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 7 Aug 2023 20:26:52 +0200 Subject: [PATCH 6/9] Discarding boxplot outliers (#5379) * Add `outliers` param to boxplot * Add test * Redocument * Add news bullet --- NEWS.md | 6 ++++++ R/geom-boxplot.R | 21 ++++++++++++++------- man/geom_boxplot.Rd | 16 +++++++++------- tests/testthat/test-geom-boxplot.R | 9 +++++++++ 4 files changed, 38 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index b62ba9eba0..099a3142dc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* `geom_boxplot()` gains an `outliers` argument to switch outliers on or off, + in a manner that does affects the scale range. For hiding outliers that does + not affect the scale range, you can continue to use `outlier.shape = NA` + (@teunbrand, #4892). + * Binned scales now treat `NA`s in limits the same way continuous scales do (#5355). @@ -9,6 +14,7 @@ deprecated. The `hjust` setting of the `legend.text` and `legend.title` elements continues to fulfil the role of text alignment (@teunbrand, #5347). + * Integers are once again valid input to theme arguments that expect numeric input (@teunbrand, #5369) diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R index 6b4160dd88..33528157f3 100644 --- a/R/geom-boxplot.R +++ b/R/geom-boxplot.R @@ -33,6 +33,12 @@ #' @inheritParams geom_bar #' @param geom,stat Use to override the default connection between #' `geom_boxplot()` and `stat_boxplot()`. +#' @param outliers Whether to display (`TRUE`) or discard (`FALSE`) outliers +#' from the plot. Hiding or discarding outliers can be useful when, for +#' example, raw data points need to be displayed on top of the boxplot. +#' By discarding outliers, the axis limits will adapt to the box and whiskers +#' only, not the full data range. If outliers need to be hidden and the axes +#' needs to show the full data range, please use `outlier.shape = NA` instead. #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha #' Default aesthetics for outliers. Set to `NULL` to inherit from the #' aesthetics used for the box. @@ -40,12 +46,6 @@ #' In the unlikely event you specify both US and UK spellings of colour, the #' US spelling will take precedence. #' -#' Sometimes it can be useful to hide the outliers, for example when overlaying -#' the raw data points on top of the boxplot. Hiding the outliers can be achieved -#' by setting `outlier.shape = NA`. Importantly, this does not remove the outliers, -#' it only hides them, so the range calculated for the y-axis will be the -#' same with outliers shown and outliers hidden. -#' #' @param notch If `FALSE` (default) make a standard box plot. If #' `TRUE`, make a notched box plot. Notches are used to compare groups; #' if the notches of two boxes do not overlap, this suggests that the medians @@ -109,6 +109,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, stat = "boxplot", position = "dodge2", ..., + outliers = TRUE, outlier.colour = NULL, outlier.color = NULL, outlier.fill = NULL, @@ -133,6 +134,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, position$preserve <- "single" } } + check_bool(outliers) layer( data = data, @@ -143,6 +145,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, show.legend = show.legend, inherit.aes = inherit.aes, params = list2( + outliers = outliers, outlier.colour = outlier.color %||% outlier.colour, outlier.fill = outlier.fill, outlier.shape = outlier.shape, @@ -167,7 +170,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # need to declare `width` here in case this geom is used with a stat that # doesn't have a `width` parameter (e.g., `stat_identity`). - extra_params = c("na.rm", "width", "orientation"), + extra_params = c("na.rm", "width", "orientation", "outliers"), setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params) @@ -180,6 +183,10 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, data$width <- data$width %||% params$width %||% (resolution(data$x, FALSE) * 0.9) + if (isFALSE(params$outliers)) { + data$outliers <- NULL + } + if (!is.null(data$outliers)) { suppressWarnings({ out_min <- vapply(data$outliers, min, numeric(1)) diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index 86ea238000..5948e6b2c4 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -11,6 +11,7 @@ geom_boxplot( stat = "boxplot", position = "dodge2", ..., + outliers = TRUE, outlier.colour = NULL, outlier.color = NULL, outlier.fill = NULL, @@ -71,17 +72,18 @@ often aesthetics, used to set an aesthetic to a fixed value, like \code{colour = "red"} or \code{size = 3}. They may also be parameters to the paired geom/stat.} +\item{outliers}{Whether to display (\code{TRUE}) or discard (\code{FALSE}) outliers +from the plot. Hiding or discarding outliers can be useful when, for +example, raw data points need to be displayed on top of the boxplot. +By discarding outliers, the axis limits will adapt to the box and whiskers +only, not the full data range. If outliers need to be hidden and the axes +needs to show the full data range, please use \code{outlier.shape = NA} instead.} + \item{outlier.colour, outlier.color, outlier.fill, outlier.shape, outlier.size, outlier.stroke, outlier.alpha}{Default aesthetics for outliers. Set to \code{NULL} to inherit from the aesthetics used for the box. In the unlikely event you specify both US and UK spellings of colour, the -US spelling will take precedence. - -Sometimes it can be useful to hide the outliers, for example when overlaying -the raw data points on top of the boxplot. Hiding the outliers can be achieved -by setting \code{outlier.shape = NA}. Importantly, this does not remove the outliers, -it only hides them, so the range calculated for the y-axis will be the -same with outliers shown and outliers hidden.} +US spelling will take precedence.} \item{notch}{If \code{FALSE} (default) make a standard box plot. If \code{TRUE}, make a notched box plot. Notches are used to compare groups; diff --git a/tests/testthat/test-geom-boxplot.R b/tests/testthat/test-geom-boxplot.R index 5414b3fdfa..f7ec35ef4c 100644 --- a/tests/testthat/test-geom-boxplot.R +++ b/tests/testthat/test-geom-boxplot.R @@ -8,6 +8,15 @@ test_that("geom_boxplot range includes all outliers", { expect_true(miny <= min(dat$y)) expect_true(maxy >= max(dat$y)) + + # Unless specifically directed not to + p <- ggplot_build(ggplot(dat, aes(x, y)) + geom_boxplot(outliers = FALSE)) + + miny <- p$layout$panel_params[[1]]$y.range[1] + maxy <- p$layout$panel_params[[1]]$y.range[2] + + expect_lte(maxy, max(dat$y)) + expect_gte(miny, min(dat$y)) }) test_that("geom_boxplot works in both directions", { From 939562927c6adafa097a7e790e1cb71c10713d54 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 7 Aug 2023 20:48:42 +0200 Subject: [PATCH 7/9] Fix partial matching (#5378) --- R/stat-ydensity.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R index 9cfca40e8b..a090898dea 100644 --- a/R/stat-ydensity.R +++ b/R/stat-ydensity.R @@ -95,8 +95,11 @@ StatYdensity <- ggproto("StatYdensity", Stat, range <- range(data$y, na.rm = TRUE) modifier <- if (trim) 0 else 3 bw <- calc_bw(data$y, bw) - dens <- compute_density(data$y, data$w, from = range[1] - modifier*bw, to = range[2] + modifier*bw, - bw = bw, adjust = adjust, kernel = kernel) + dens <- compute_density( + data$y, data[["weight"]], + from = range[1] - modifier * bw, to = range[2] + modifier * bw, + bw = bw, adjust = adjust, kernel = kernel + ) dens$y <- dens$x dens$x <- mean(range(data$x)) From da2a8e80d267fdf33e767792adf3b98f0e28dff7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 7 Aug 2023 21:21:19 +0200 Subject: [PATCH 8/9] Consider `linewidth` in legend key sizes (#5346) * Key size accounts for linewidth * Add test * Add bullet --- NEWS.md | 2 + R/guide-legend.R | 20 ++-- .../_snaps/guides/enlarged-guides.svg | 96 +++++++++++++++++++ tests/testthat/test-guides.R | 11 +++ 4 files changed, 118 insertions(+), 11 deletions(-) create mode 100644 tests/testthat/_snaps/guides/enlarged-guides.svg diff --git a/NEWS.md b/NEWS.md index 099a3142dc..64d2529a02 100644 --- a/NEWS.md +++ b/NEWS.md @@ -75,6 +75,8 @@ * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152). * `guide_axis()` gains a `cap` argument that can be used to trim the axis line to extreme breaks (#4907). + * Fixed regression in `guide_legend()` where the `linewidth` key size + wasn't adapted to the width of the lines (#5160). * `geom_label()` now uses the `angle` aesthetic (@teunbrand, #2785) * 'lines' units in `geom_label()`, often used in the `label.padding` argument, diff --git a/R/guide-legend.R b/R/guide-legend.R index b80062d618..4667e50388 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -329,10 +329,6 @@ GuideLegend <- ggproto( data <- modify_list(data, params$override.aes) - if (!is.null(data$size)) { - data$size[is.na(data$size)] <- 0 - } - list( draw_key = layer$geom$draw_key, data = data, @@ -728,15 +724,17 @@ measure_legend_keys <- function(decor, n, dim, byrow = FALSE, zeroes <- rep(0, prod(dim) - n) # For every layer, extract the size in cm - size <- lapply(decor, function(g) g$data$size / 10) # mm to cm + size <- lapply(decor, function(g) { + lwd <- g$data$linewidth %||% 0 + lwd[is.na(lwd)] <- 0 + size <- g$data$size %||% 0 + size[is.na(size)] <- 0 + vec_recycle((size + lwd) / 10, size = nrow(g$data)) + }) size <- inject(cbind(!!!size)) - # Guard against layers with no size aesthetic - if (any(dim(size) == 0)) { - size <- matrix(0, ncol = 1, nrow = n) - } else { - size <- size[seq_len(n), , drop = FALSE] - } + # Binned legends may have `n + 1` breaks, but we need to display `n` keys. + size <- vec_slice(size, seq_len(n)) # For every key, find maximum across all layers size <- apply(size, 1, max) diff --git a/tests/testthat/_snaps/guides/enlarged-guides.svg b/tests/testthat/_snaps/guides/enlarged-guides.svg new file mode 100644 index 0000000000..69c7aaba61 --- /dev/null +++ b/tests/testthat/_snaps/guides/enlarged-guides.svg @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +x +x + +x + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + +2 - x + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +enlarged guides + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index ce111a2fcc..a19de230b6 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -627,6 +627,17 @@ test_that("guides title and text are positioned correctly", { expect_doppelganger("rotated guide titles and labels", p ) }) +test_that("size and linewidth affect key size", { + df <- data_frame(x = c(0, 1, 2)) + p <- ggplot(df, aes(x, x)) + + geom_point(aes(size = x)) + + geom_line(aes(linewidth = 2 - x)) + + scale_size_continuous(range = c(1, 12)) + + scale_linewidth_continuous(range = c(1, 20)) + + expect_doppelganger("enlarged guides", p) +}) + test_that("colorbar can be styled", { df <- data_frame(x = c(0, 1, 2)) p <- ggplot(df, aes(x, x, color = x)) + geom_point() From bde88f82a1c3343f7172a38aa4f3e4cef34777f3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 7 Aug 2023 22:00:22 +0200 Subject: [PATCH 9/9] Convert `size` -> `linewidth` in `annotation_logticks()` (#5330) --- NEWS.md | 4 +++- R/annotation-logticks.R | 23 +++++++++++++++-------- man/annotation_logticks.Rd | 9 ++++++--- tests/testthat/_snaps/annotate.md | 5 +++++ tests/testthat/test-annotate.R | 4 ++++ 5 files changed, 33 insertions(+), 12 deletions(-) diff --git a/NEWS.md b/NEWS.md index 64d2529a02..8fe979a6a8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # ggplot2 (development version) +* The `size` argument in `annotation_logticks()` has been deprecated in favour + of the `linewidth` argument (#5292). + * `geom_boxplot()` gains an `outliers` argument to switch outliers on or off, in a manner that does affects the scale range. For hiding outliers that does not affect the scale range, you can continue to use `outlier.shape = NA` @@ -14,7 +17,6 @@ deprecated. The `hjust` setting of the `legend.text` and `legend.title` elements continues to fulfil the role of text alignment (@teunbrand, #5347). - * Integers are once again valid input to theme arguments that expect numeric input (@teunbrand, #5369) diff --git a/R/annotation-logticks.R b/R/annotation-logticks.R index 62cb58114d..3432cac3b5 100644 --- a/R/annotation-logticks.R +++ b/R/annotation-logticks.R @@ -21,11 +21,12 @@ #' using `scale_y_log10()`. It should be `FALSE` when using #' `coord_trans(y = "log10")`. #' @param colour Colour of the tick marks. -#' @param size Thickness of tick marks, in mm. +#' @param linewidth Thickness of tick marks, in mm. #' @param linetype Linetype of tick marks (`solid`, `dashed`, etc.) #' @param alpha The transparency of the tick marks. #' @param color An alias for `colour`. #' @param ... Other parameters passed on to the layer +#' @param size `r lifecycle::badge("deprecated")` #' #' @export #' @seealso [scale_y_continuous()], [scale_y_log10()] for log scale @@ -81,11 +82,17 @@ #' ) annotation_logticks <- function(base = 10, sides = "bl", outside = FALSE, scaled = TRUE, short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"), - colour = "black", size = 0.5, linetype = 1, alpha = 1, color = NULL, ...) + colour = "black", linewidth = 0.5, linetype = 1, alpha = 1, color = NULL, ..., + size = deprecated()) { if (!is.null(color)) colour <- color + if (lifecycle::is_present(size)) { + deprecate_soft0("3.5.0", I("Using the `size` aesthetic in this geom"), I("`linewidth`")) + linewidth <- linewidth %||% size + } + layer( data = dummy_data(), mapping = NULL, @@ -103,7 +110,7 @@ annotation_logticks <- function(base = 10, sides = "bl", outside = FALSE, scaled mid = mid, long = long, colour = colour, - size = size, + linewidth = linewidth, linetype = linetype, alpha = alpha, ... @@ -163,14 +170,14 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, ticks$x_b <- with(data, segmentsGrob( x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"), y0 = unit(xticks$start, "cm"), y1 = unit(xticks$end, "cm"), - gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt) + gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt) )) } if (grepl("t", sides) && nrow(xticks) > 0) { ticks$x_t <- with(data, segmentsGrob( x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"), y0 = unit(1, "npc") - unit(xticks$start, "cm"), y1 = unit(1, "npc") - unit(xticks$end, "cm"), - gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt) + gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt) )) } } @@ -201,14 +208,14 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, ticks$y_l <- with(data, segmentsGrob( y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"), x0 = unit(yticks$start, "cm"), x1 = unit(yticks$end, "cm"), - gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt) + gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt) )) } if (grepl("r", sides) && nrow(yticks) > 0) { ticks$y_r <- with(data, segmentsGrob( y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"), x0 = unit(1, "npc") - unit(yticks$start, "cm"), x1 = unit(1, "npc") - unit(yticks$end, "cm"), - gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt) + gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt) )) } } @@ -216,7 +223,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, gTree(children = inject(gList(!!!ticks))) }, - default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1) + default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = 1) ) diff --git a/man/annotation_logticks.Rd b/man/annotation_logticks.Rd index 35083eb1e2..088daf1fe1 100644 --- a/man/annotation_logticks.Rd +++ b/man/annotation_logticks.Rd @@ -13,11 +13,12 @@ annotation_logticks( mid = unit(0.2, "cm"), long = unit(0.3, "cm"), colour = "black", - size = 0.5, + linewidth = 0.5, linetype = 1, alpha = 1, color = NULL, - ... + ..., + size = deprecated() ) } \arguments{ @@ -47,7 +48,7 @@ long tick marks. In base 10, these are the "1" (or "10") ticks.} \item{colour}{Colour of the tick marks.} -\item{size}{Thickness of tick marks, in mm.} +\item{linewidth}{Thickness of tick marks, in mm.} \item{linetype}{Linetype of tick marks (\code{solid}, \code{dashed}, etc.)} @@ -56,6 +57,8 @@ long tick marks. In base 10, these are the "1" (or "10") ticks.} \item{color}{An alias for \code{colour}.} \item{...}{Other parameters passed on to the layer} + +\item{size}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} } \description{ This annotation adds log tick marks with diminishing spacing. diff --git a/tests/testthat/_snaps/annotate.md b/tests/testthat/_snaps/annotate.md index 8bc64a7561..22f7005c0a 100644 --- a/tests/testthat/_snaps/annotate.md +++ b/tests/testthat/_snaps/annotate.md @@ -29,3 +29,8 @@ Unequal parameter lengths: x (3), y (3), and fill (2) +# annotation_logticks warns about deprecated `size` argument + + Using the `size` aesthetic in this geom was deprecated in ggplot2 3.5.0. + i Please use `linewidth` instead. + diff --git a/tests/testthat/test-annotate.R b/tests/testthat/test-annotate.R index 2407475059..68bfcd4e26 100644 --- a/tests/testthat/test-annotate.R +++ b/tests/testthat/test-annotate.R @@ -77,3 +77,7 @@ test_that("unsupported geoms signal a warning (#4719)", { test_that("annotate() checks aesthetic lengths match", { expect_snapshot_error(annotate("point", 1:3, 1:3, fill = c('red', 'black'))) }) + +test_that("annotation_logticks warns about deprecated `size` argument", { + expect_snapshot_warning(annotation_logticks(size = 5)) +})