From 25ad0b17865c1280c464ccfbee38c3d7eb5df95d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 15 Jul 2024 23:01:14 +0200 Subject: [PATCH 01/31] exclude `palette` as dot param (#5992) --- R/scale-gradient.R | 2 +- R/scale-grey.R | 2 +- R/scale-hue.R | 2 +- R/scale-linetype.R | 2 +- R/scale-shape.R | 2 +- man/scale_gradient.Rd | 3 --- man/scale_grey.Rd | 3 --- man/scale_hue.Rd | 3 --- man/scale_linetype.Rd | 3 --- man/scale_shape.Rd | 3 --- 10 files changed, 5 insertions(+), 20 deletions(-) diff --git a/R/scale-gradient.R b/R/scale-gradient.R index 788ee3e9f0..32f61a2e8e 100644 --- a/R/scale-gradient.R +++ b/R/scale-gradient.R @@ -16,7 +16,7 @@ #' @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 -expand -position +#' @inheritDotParams continuous_scale -na.value -guide -aesthetics -expand -position -palette #' @seealso [scales::pal_seq_gradient()] for details on underlying #' palette, [scale_colour_steps()] for binned variants of these scales. #' diff --git a/R/scale-grey.R b/R/scale-grey.R index b3683295f7..cc6a88033e 100644 --- a/R/scale-grey.R +++ b/R/scale-grey.R @@ -5,7 +5,7 @@ #' #' @inheritParams scales::pal_grey #' @inheritParams scale_colour_hue -#' @inheritDotParams discrete_scale -expand -position -scale_name +#' @inheritDotParams discrete_scale -expand -position -scale_name -palette #' @family colour scales #' @seealso #' The documentation on [colour aesthetics][aes_colour_fill_alpha]. diff --git a/R/scale-hue.R b/R/scale-hue.R index ba50f81dc2..db743612ed 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -4,7 +4,7 @@ #' It does not generate colour-blind safe palettes. #' #' @param na.value Colour to use for missing values -#' @inheritDotParams discrete_scale -aesthetics -expand -position -scale_name +#' @inheritDotParams discrete_scale -aesthetics -expand -position -scale_name -palette #' @param aesthetics Character string or vector of character strings listing the #' 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 diff --git a/R/scale-linetype.R b/R/scale-linetype.R index a1b983b23d..bc4fa0ce71 100644 --- a/R/scale-linetype.R +++ b/R/scale-linetype.R @@ -6,7 +6,7 @@ #' no inherent order, this use is not advised. #' #' @inheritParams scale_x_discrete -#' @inheritDotParams discrete_scale -expand -position -na.value -scale_name +#' @inheritDotParams discrete_scale -expand -position -na.value -scale_name -palette #' @param na.value The linetype to use for `NA` values. #' @rdname scale_linetype #' @seealso diff --git a/R/scale-shape.R b/R/scale-shape.R index 7c4c750519..ecb8a2a2a1 100644 --- a/R/scale-shape.R +++ b/R/scale-shape.R @@ -10,7 +10,7 @@ #' @param solid Should the shapes be solid, `TRUE`, or hollow, #' `FALSE`? #' @inheritParams scale_x_discrete -#' @inheritDotParams discrete_scale -expand -position -scale_name +#' @inheritDotParams discrete_scale -expand -position -scale_name -palette #' @rdname scale_shape #' @seealso #' The documentation for [differentiation related aesthetics][aes_linetype_size_shape]. diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index f861378c0c..619e71f3ef 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -103,9 +103,6 @@ omitted.} \describe{ \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale that should be used for error messages associated with this scale.} - \item{\code{palette}}{A palette function that when called with a numeric vector with -values between 0 and 1 returns the corresponding output values -(e.g., \code{\link[scales:pal_area]{scales::pal_area()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index 6b04f40688..0ee97a15de 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -33,9 +33,6 @@ omitted.} \item{...}{ Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}} \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: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 99776d95d3..1280e741bb 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -39,9 +39,6 @@ omitted.} \item{...}{ Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}} \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: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 da4cf2b7c3..9b57b40978 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -24,9 +24,6 @@ omitted.} \item{...}{ Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}} \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:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index ffbb381481..8c8b8320fc 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -21,9 +21,6 @@ omitted.} \item{...}{ Arguments passed on to \code{\link[=discrete_scale]{discrete_scale}} \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:pal_hue]{scales::pal_hue()}}).} \item{\code{breaks}}{One of: \itemize{ \item \code{NULL} for no breaks From 7fb4c382f9ea332844d469663a8047355a88dd7a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 17 Jul 2024 17:55:28 +0200 Subject: [PATCH 02/31] Exclude labels from `aes_params` field (#6004) * exclude labels from `aes_params` * add test --- R/labels.R | 2 ++ tests/testthat/test-labels.R | 15 +++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/R/labels.R b/R/labels.R index 3012868874..2bc5551034 100644 --- a/R/labels.R +++ b/R/labels.R @@ -24,9 +24,11 @@ setup_plot_labels <- function(plot, layers, data) { # Find labels from every layer for (i in seq_along(layers)) { layer <- layers[[i]] + exclude <- names(layer$aes_params) mapping <- layer$computed_mapping mapping <- strip_stage(mapping) mapping <- strip_dots(mapping, strip_pronoun = TRUE) + mapping <- mapping[setdiff(names(mapping), exclude)] # Acquire default labels mapping_default <- make_labels(mapping) diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index e338226bd4..c659e39cf5 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -74,6 +74,21 @@ test_that("Labels can be extracted from attributes", { expect_equal(labels$y, "disp") }) +test_that("Labels from static aesthetics are ignored (#6003)", { + + df <- data.frame(x = 1, y = 1, f = 1) + + p <- ggplot(df, aes(x, y, colour = f)) + geom_point() + labels <- ggplot_build(p)$plot$labels + + expect_equal(labels$colour, "f") + + p <- ggplot(df, aes(x, y, colour = f)) + geom_point(colour = "blue") + labels <- ggplot_build(p)$plot$labels + + expect_null(labels$colour) +}) + test_that("alt text is returned", { p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() From 8895ec2d4dcb7000737fec249d3a93d5879aa823 Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Tue, 6 Aug 2024 03:31:49 -0400 Subject: [PATCH 03/31] Update CONTRIBUTING.md (#6030) --- CONTRIBUTING.md | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 8796efb5d8..77553769db 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -61,20 +61,19 @@ Each of these steps are described in more detail below. This might feel overwhelming the first time you get set up, but it gets easier with practice. If you get stuck at any point, please reach out for help on the [ggplot2-dev](https://groups.google.com/forum/#!forum/ggplot2-dev) mailing list. -If you're not familiar with git or github, please start by reading +If you're not familiar with git or github, please start by reading Pull requests will be evaluated against a seven point checklist: @@ -100,20 +99,16 @@ Pull requests will be evaluated against a seven point checklist: and don't submit any others until the first one has been processed. 1. __Use ggplot2 coding style__. Please follow the - [official tidyverse style](http://style.tidyverse.org). Maintaining + [official tidyverse style](https://style.tidyverse.org). Maintaining a consistent style across the whole code base makes it much easier to jump into the code. If you're modifying existing ggplot2 code that doesn't follow the style guide, a separate pull request to fix the style would be greatly appreciated. 1. If you're adding new parameters or a new function, you'll also need - to document them with [roxygen](https://github.com/klutometis/roxygen). + to document them with [roxygen2](https://github.com/r-lib/roxygen2). Make sure to re-run `devtools::document()` on the code before submitting. - Currently, ggplot2 uses the development version of roxygen2, which you - can get with `install_github("klutometis/roxygen")`. This will be - available on CRAN in the near future. - 1. If fixing a bug or adding a new feature to a non-graphical function, please add a [testthat](https://github.com/r-lib/testthat) unit test. From 09d5c35f24d8df43be9236f5e2a8ef3faf5c828f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 7 Aug 2024 13:52:51 +0200 Subject: [PATCH 04/31] Use latest GHA workflows (#6028) --- .github/workflows/R-CMD-check.yaml | 25 ++++++++++++++----------- .github/workflows/pkgdown.yaml | 10 +++++++--- .github/workflows/pr-commands.yaml | 12 +++++++++--- .github/workflows/test-coverage.yaml | 25 ++++++++++++++++++------- 4 files changed, 48 insertions(+), 24 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index cfdefdb714..2e6d40ab70 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -10,7 +10,9 @@ on: pull_request: branches: [main, master] -name: R-CMD-check +name: R-CMD-check.yaml + +permissions: read-all jobs: R-CMD-check: @@ -25,15 +27,15 @@ jobs: - {os: macos-latest, r: 'release'} - {os: windows-latest, r: 'release'} - # use 4.1 to check with rtools40's older compiler - - {os: windows-latest, r: '4.1'} + # use 4.0 or 4.1 to check with rtools40's older compiler + - {os: windows-latest, r: 'oldrel-4'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} - - {os: ubuntu-latest, r: 'oldrel-2'} - - {os: ubuntu-latest, r: 'oldrel-3'} - - {os: ubuntu-latest, r: 'oldrel-4'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: ubuntu-latest, r: 'oldrel-2'} + - {os: ubuntu-latest, r: 'oldrel-3'} + - {os: ubuntu-latest, r: 'oldrel-4'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -46,7 +48,7 @@ jobs: VDIFFR_LOG_PATH: "../vdiffr.Rout.fail" steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -62,9 +64,10 @@ jobs: extra-packages: > any::rcmdcheck, Hmisc=?ignore-before-r=4.1.0, - quantreg=?ignore-before-r=4.3.0, + quantreg=?ignore-before-r=4.3.0 needs: check - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 087f0b05fc..4bbce75080 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -9,7 +9,9 @@ on: types: [published] workflow_dispatch: -name: pkgdown +name: pkgdown.yaml + +permissions: read-all jobs: pkgdown: @@ -19,8 +21,10 @@ jobs: group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 @@ -39,7 +43,7 @@ jobs: - name: Deploy to GitHub pages 🚀 if: github.event_name != 'pull_request' - uses: JamesIves/github-pages-deploy-action@v4.4.1 + uses: JamesIves/github-pages-deploy-action@v4.5.0 with: clean: false branch: gh-pages diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml index 71f335b3ea..2edd93f27e 100644 --- a/.github/workflows/pr-commands.yaml +++ b/.github/workflows/pr-commands.yaml @@ -4,7 +4,9 @@ on: issue_comment: types: [created] -name: Commands +name: pr-commands.yaml + +permissions: read-all jobs: document: @@ -13,8 +15,10 @@ jobs: runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/pr-fetch@v2 with: @@ -50,8 +54,10 @@ jobs: runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + permissions: + contents: write steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/pr-fetch@v2 with: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 2c5bb50294..988226098e 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -6,7 +6,9 @@ on: pull_request: branches: [main, master] -name: test-coverage +name: test-coverage.yaml + +permissions: read-all jobs: test-coverage: @@ -15,7 +17,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: @@ -23,28 +25,37 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr + extra-packages: any::covr, any::xml2 needs: coverage - name: Test coverage run: | - covr::codecov( + cov <- covr::package_coverage( quiet = FALSE, clean = FALSE, - install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) + covr::to_cobertura(cov) shell: Rscript {0} + - uses: codecov/codecov-action@v4 + with: + fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + - name: Show testthat output if: always() run: | ## -------------------------------------------------------------------- - find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true shell: bash - name: Upload test results if: failure() - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: coverage-test-failures path: ${{ runner.temp }}/package From b1a7a58bc932f66424072bc464270533c6c404f7 Mon Sep 17 00:00:00 2001 From: agmurray Date: Thu, 15 Aug 2024 10:31:32 -0700 Subject: [PATCH 05/31] Adding the option `seed = 0` into the jitter argument (#6035) Fixes #5875 --- DESCRIPTION | 2 +- R/position-jitter.R | 2 +- man/position_jitter.Rd | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3f34454b36..d97ce7e689 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -78,7 +78,7 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Collate: 'ggproto.R' 'ggplot-global.R' diff --git a/R/position-jitter.R b/R/position-jitter.R index 99d807fbe3..ddf59d090b 100644 --- a/R/position-jitter.R +++ b/R/position-jitter.R @@ -41,7 +41,7 @@ #' geom_jitter(position = position_jitter(width = 0.1, height = 0.1)) #' #' # Create a jitter object for reproducible jitter: -#' jitter <- position_jitter(width = 0.1, height = 0.1) +#' jitter <- position_jitter(width = 0.1, height = 0.1, seed = 0) #' ggplot(mtcars, aes(am, vs)) + #' geom_point(position = jitter) + #' geom_point(position = jitter, color = "red", aes(am + 0.2, vs + 0.2)) diff --git a/man/position_jitter.Rd b/man/position_jitter.Rd index d0531116d6..b43f4ade40 100644 --- a/man/position_jitter.Rd +++ b/man/position_jitter.Rd @@ -49,7 +49,7 @@ ggplot(mtcars, aes(am, vs)) + geom_jitter(position = position_jitter(width = 0.1, height = 0.1)) # Create a jitter object for reproducible jitter: -jitter <- position_jitter(width = 0.1, height = 0.1) +jitter <- position_jitter(width = 0.1, height = 0.1, seed = 0) ggplot(mtcars, aes(am, vs)) + geom_point(position = jitter) + geom_point(position = jitter, color = "red", aes(am + 0.2, vs + 0.2)) From c1b62755a390bb4d707a42a87131a0c5318aadb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Catalina=20Ca=C3=B1izares?= <88352293+ccani007@users.noreply.github.com> Date: Thu, 15 Aug 2024 10:45:26 -0700 Subject: [PATCH 06/31] Fixes # 5960 (#6036) Changed "unscaled x" because the function takes transformed values. --- R/stat-bin.R | 7 +++---- man/geom_histogram.Rd | 7 +++---- man/stat_summary.Rd | 7 +++---- 3 files changed, 9 insertions(+), 12 deletions(-) diff --git a/R/stat-bin.R b/R/stat-bin.R index 4c00b2e3ab..c085f818a2 100644 --- a/R/stat-bin.R +++ b/R/stat-bin.R @@ -1,8 +1,7 @@ #' @param binwidth The width of the bins. Can be specified as a numeric value -#' or as a function that calculates width from unscaled x. Here, "unscaled x" -#' refers to the original x values in the data, before application of any -#' scale transformation. When specifying a function along with a grouping -#' structure, the function will be called once per group. +#' or as a function that takes x after scale transformation as input and +#' returns a single numeric value. When specifying a function along with a +#' grouping structure, the function will be called once per group. #' The default is to use the number of bins in `bins`, #' covering the range of the data. You should always override #' this value, exploring multiple widths to find the best to illustrate the diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index f60ec4b1f5..a4a95c503f 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -128,10 +128,9 @@ that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[=borders]{borders()}}.} \item{binwidth}{The width of the bins. Can be specified as a numeric value -or as a function that calculates width from unscaled x. Here, "unscaled x" -refers to the original x values in the data, before application of any -scale transformation. When specifying a function along with a grouping -structure, the function will be called once per group. +or as a function that takes x after scale transformation as input and +returns a single numeric value. When specifying a function along with a +grouping structure, the function will be called once per group. The default is to use the number of bins in \code{bins}, covering the range of the data. You should always override this value, exploring multiple widths to find the best to illustrate the diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 034e11afdb..83cbe4c9a7 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -135,10 +135,9 @@ single number.} \item{bins}{Number of bins. Overridden by \code{binwidth}. Defaults to 30.} \item{binwidth}{The width of the bins. Can be specified as a numeric value -or as a function that calculates width from unscaled x. Here, "unscaled x" -refers to the original x values in the data, before application of any -scale transformation. When specifying a function along with a grouping -structure, the function will be called once per group. +or as a function that takes x after scale transformation as input and +returns a single numeric value. When specifying a function along with a +grouping structure, the function will be called once per group. The default is to use the number of bins in \code{bins}, covering the range of the data. You should always override this value, exploring multiple widths to find the best to illustrate the From c706a01a62d96678f98dfef7eee3fde94e54ae34 Mon Sep 17 00:00:00 2001 From: Sierra Johnson <80361498+sierrajohnson@users.noreply.github.com> Date: Thu, 15 Aug 2024 14:30:55 -0600 Subject: [PATCH 07/31] Add labeller example for optional argument. Fixes #5916 (#6038) --- R/labeller.R | 3 +++ man/labellers.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/R/labeller.R b/R/labeller.R index 442f05d496..3dbb9b63ac 100644 --- a/R/labeller.R +++ b/R/labeller.R @@ -83,6 +83,9 @@ #' # Interpreting the labels as plotmath expressions #' p + facet_grid(. ~ cyl2) #' p + facet_grid(. ~ cyl2, labeller = label_parsed) +#' +#' # Include optional argument in label function +#' p + facet_grid(. ~ cyl, labeller = function(x) label_both(x, sep = "=")) #' } #' @name labellers NULL diff --git a/man/labellers.Rd b/man/labellers.Rd index 63a4980eb7..09f160bf40 100644 --- a/man/labellers.Rd +++ b/man/labellers.Rd @@ -108,6 +108,9 @@ p + facet_grid(am ~ vs+cyl, labeller = label_context) # Interpreting the labels as plotmath expressions p + facet_grid(. ~ cyl2) p + facet_grid(. ~ cyl2, labeller = label_parsed) + +# Include optional argument in label function +p + facet_grid(. ~ cyl, labeller = function(x) label_both(x, sep = "=")) } } \seealso{ From c4c826a3979f16e1dd19c42f508ab0b018de9b02 Mon Sep 17 00:00:00 2001 From: Sierra Johnson <80361498+sierrajohnson@users.noreply.github.com> Date: Thu, 15 Aug 2024 14:52:33 -0600 Subject: [PATCH 08/31] Making bw argument in stat_density case insensitive. Fixes #5941 (#6041) --- R/stat-density.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/stat-density.R b/R/stat-density.R index 27cafd4b6d..add18570fc 100644 --- a/R/stat-density.R +++ b/R/stat-density.R @@ -242,6 +242,7 @@ reflect_density <- function(dens, bounds, from, to) { precompute_bw = function(x, bw = "nrd0") { bw <- bw[1] if (is.character(bw)) { + bw <- to_lower_ascii(bw) bw <- arg_match0(bw, c("nrd0", "nrd", "ucv", "bcv", "sj", "sj-ste", "sj-dpi")) bw <- switch( to_lower_ascii(bw), From 7572d09cbb54f52ff0963d1a71f6f11d7c9b149d Mon Sep 17 00:00:00 2001 From: Stephen Uong <47620395+phispu@users.noreply.github.com> Date: Thu, 15 Aug 2024 13:57:46 -0700 Subject: [PATCH 09/31] Updated documentation: confidence intervals to confidence bands. Fixes #6025 (#6040) --- R/geom-smooth.R | 2 +- R/stat-smooth.R | 8 ++++---- man/geom_smooth.Rd | 10 +++++----- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/geom-smooth.R b/R/geom-smooth.R index 0c3432620c..2247bf2a5b 100644 --- a/R/geom-smooth.R +++ b/R/geom-smooth.R @@ -9,7 +9,7 @@ #' `predictdf()` generic and its methods. For most methods the standard #' error bounds are computed using the [predict()] method -- the #' exceptions are `loess()`, which uses a t-based approximation, and -#' `glm()`, where the normal confidence interval is constructed on the link +#' `glm()`, where the normal confidence band is constructed on the link #' scale and then back-transformed to the response scale. #' #' @eval rd_orientation() diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 864e229edf..9c72d3570c 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -18,7 +18,7 @@ #' `y ~ poly(x, 2)`, `y ~ log(x)`. `NULL` by default, in which case #' `method = NULL` implies `formula = y ~ x` when there are fewer than 1,000 #' observations and `formula = y ~ s(x, bs = "cs")` otherwise. -#' @param se Display confidence interval around smooth? (`TRUE` by default, see +#' @param se Display confidence band around smooth? (`TRUE` by default, see #' `level` to control.) #' @param fullrange If `TRUE`, the smoothing line gets expanded to the range of the plot, #' potentially beyond the data. This does not extend the line into any additional padding @@ -26,7 +26,7 @@ #' @param xseq A numeric vector of values at which the smoother is evaluated. #' When `NULL` (default), `xseq` is internally evaluated as a sequence of `n` #' equally spaced points for continuous data. -#' @param level Level of confidence interval to use (0.95 by default). +#' @param level Level of confidence band to use (0.95 by default). #' @param span Controls the amount of smoothing for the default loess smoother. #' Smaller numbers produce wigglier lines, larger numbers produce smoother #' lines. Only used with loess, i.e. when `method = "loess"`, @@ -40,8 +40,8 @@ #' .details = "`stat_smooth()` provides the following variables, some of #' which depend on the orientation:", #' "y|x" = "Predicted value.", -#' "ymin|xmin" = "Lower pointwise confidence interval around the mean.", -#' "ymax|xmax" = "Upper pointwise confidence interval around the mean.", +#' "ymin|xmin" = "Lower pointwise confidence band around the mean.", +#' "ymax|xmax" = "Upper pointwise confidence band around the mean.", #' "se" = "Standard error." #' ) #' @export diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index ece17611a4..67c0c3e0c7 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -125,7 +125,7 @@ model that \code{method = NULL} would use, then set \code{method = NULL} implies \code{formula = y ~ x} when there are fewer than 1,000 observations and \code{formula = y ~ s(x, bs = "cs")} otherwise.} -\item{se}{Display confidence interval around smooth? (\code{TRUE} by default, see +\item{se}{Display confidence band around smooth? (\code{TRUE} by default, see \code{level} to control.)} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with @@ -168,7 +168,7 @@ created by \code{expansion}.} When \code{NULL} (default), \code{xseq} is internally evaluated as a sequence of \code{n} equally spaced points for continuous data.} -\item{level}{Level of confidence interval to use (0.95 by default).} +\item{level}{Level of confidence band to use (0.95 by default).} \item{method.args}{List of additional arguments passed on to the modelling function defined by \code{method}.} @@ -184,7 +184,7 @@ Calculation is performed by the (currently undocumented) \code{predictdf()} generic and its methods. For most methods the standard error bounds are computed using the \code{\link[=predict]{predict()}} method -- the exceptions are \code{loess()}, which uses a t-based approximation, and -\code{glm()}, where the normal confidence interval is constructed on the link +\code{glm()}, where the normal confidence band is constructed on the link scale and then back-transformed to the response scale. } \section{Orientation}{ @@ -216,8 +216,8 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. These are calculated by the 'stat' part of layers and can be accessed with \link[=aes_eval]{delayed evaluation}. \code{stat_smooth()} provides the following variables, some of which depend on the orientation: \itemize{ \item \code{after_stat(y)} \emph{or} \code{after_stat(x)}\cr Predicted value. -\item \code{after_stat(ymin)} \emph{or} \code{after_stat(xmin)}\cr Lower pointwise confidence interval around the mean. -\item \code{after_stat(ymax)} \emph{or} \code{after_stat(xmax)}\cr Upper pointwise confidence interval around the mean. +\item \code{after_stat(ymin)} \emph{or} \code{after_stat(xmin)}\cr Lower pointwise confidence band around the mean. +\item \code{after_stat(ymax)} \emph{or} \code{after_stat(xmax)}\cr Upper pointwise confidence band around the mean. \item \code{after_stat(se)}\cr Standard error. } } From 11244c52a202f6e672cb6fc8a943805eb4ba850a Mon Sep 17 00:00:00 2001 From: agmurray Date: Thu, 15 Aug 2024 14:13:34 -0700 Subject: [PATCH 10/31] `show.legend` for factor data for all levels, even when not observed (#6037) * Added text to show how to add color to legends for all levels, even when no data for some levels exists. Fixes #5869 * Update R/layer.R edits from Tuen Co-authored-by: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> * Includes edits from Teun to clarify language and ran `devtools::document()` --------- Co-authored-by: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> --- R/layer.R | 4 +++- man/borders.Rd | 4 +++- man/geom_abline.Rd | 4 +++- man/geom_bar.Rd | 4 +++- man/geom_bin_2d.Rd | 4 +++- man/geom_blank.Rd | 4 +++- man/geom_boxplot.Rd | 4 +++- man/geom_contour.Rd | 4 +++- man/geom_count.Rd | 4 +++- man/geom_density.Rd | 4 +++- man/geom_density_2d.Rd | 4 +++- man/geom_dotplot.Rd | 4 +++- man/geom_errorbarh.Rd | 4 +++- man/geom_function.Rd | 4 +++- man/geom_hex.Rd | 4 +++- man/geom_histogram.Rd | 4 +++- man/geom_jitter.Rd | 4 +++- man/geom_linerange.Rd | 4 +++- man/geom_map.Rd | 4 +++- man/geom_path.Rd | 4 +++- man/geom_point.Rd | 4 +++- man/geom_polygon.Rd | 4 +++- man/geom_qq.Rd | 4 +++- man/geom_quantile.Rd | 4 +++- man/geom_ribbon.Rd | 4 +++- man/geom_rug.Rd | 4 +++- man/geom_segment.Rd | 4 +++- man/geom_smooth.Rd | 4 +++- man/geom_spoke.Rd | 4 +++- man/geom_text.Rd | 4 +++- man/geom_tile.Rd | 4 +++- man/geom_violin.Rd | 4 +++- man/layer.Rd | 4 +++- man/layer_sf.Rd | 4 +++- man/stat_ecdf.Rd | 4 +++- man/stat_ellipse.Rd | 4 +++- man/stat_identity.Rd | 4 +++- man/stat_sf_coordinates.Rd | 4 +++- man/stat_summary.Rd | 4 +++- man/stat_summary_2d.Rd | 4 +++- man/stat_unique.Rd | 4 +++- 41 files changed, 123 insertions(+), 41 deletions(-) diff --git a/R/layer.R b/R/layer.R index 8b4621bde2..7fc53571ef 100644 --- a/R/layer.R +++ b/R/layer.R @@ -58,7 +58,9 @@ #' `NA`, the default, includes if any aesthetics are mapped. #' `FALSE` never includes, and `TRUE` always includes. #' It can also be a named logical vector to finely select the aesthetics to -#' display. +#' display. To include legend keys for all levels, even +#' when no data exists, use `TRUE`. If `NA`, all levels are shown in legend, +#' but unobserved levels are omitted. #' @param inherit.aes If `FALSE`, overrides the default aesthetics, #' rather than combining with them. This is most useful for helper functions #' that define both data and aesthetics and shouldn't inherit behaviour from diff --git a/man/borders.Rd b/man/borders.Rd index 1fcb3f2630..2fa16916e9 100644 --- a/man/borders.Rd +++ b/man/borders.Rd @@ -79,7 +79,9 @@ to use \code{position_jitter()}, give the position as \code{"jitter"}. \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{\code{inherit.aes}}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from diff --git a/man/geom_abline.Rd b/man/geom_abline.Rd index 8fd63ae8e0..0c3bd12b24 100644 --- a/man/geom_abline.Rd +++ b/man/geom_abline.Rd @@ -89,7 +89,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and diff --git a/man/geom_bar.Rd b/man/geom_bar.Rd index 4f8196b4c1..6c8c67cc19 100644 --- a/man/geom_bar.Rd +++ b/man/geom_bar.Rd @@ -122,7 +122,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_bin_2d.Rd b/man/geom_bin_2d.Rd index 38341bf063..fa3b32b4ce 100644 --- a/man/geom_bin_2d.Rd +++ b/man/geom_bin_2d.Rd @@ -101,7 +101,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_blank.Rd b/man/geom_blank.Rd index c547845953..1f02b9cbc6 100644 --- a/man/geom_blank.Rd +++ b/man/geom_blank.Rd @@ -93,7 +93,9 @@ lists which parameters it can accept. \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_boxplot.Rd b/man/geom_boxplot.Rd index e995aa6635..918b082d4b 100644 --- a/man/geom_boxplot.Rd +++ b/man/geom_boxplot.Rd @@ -145,7 +145,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_contour.Rd b/man/geom_contour.Rd index d53e300a79..72114072e2 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -169,7 +169,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_count.Rd b/man/geom_count.Rd index 370db388ed..1b925e7450 100644 --- a/man/geom_count.Rd +++ b/man/geom_count.Rd @@ -96,7 +96,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_density.Rd b/man/geom_density.Rd index 86bf57d6e9..58f6dae9e2 100644 --- a/man/geom_density.Rd +++ b/man/geom_density.Rd @@ -110,7 +110,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_density_2d.Rd b/man/geom_density_2d.Rd index 68f1353262..f063cfdd4a 100644 --- a/man/geom_density_2d.Rd +++ b/man/geom_density_2d.Rd @@ -138,7 +138,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_dotplot.Rd b/man/geom_dotplot.Rd index 1a57df3233..ff7f30a4fc 100644 --- a/man/geom_dotplot.Rd +++ b/man/geom_dotplot.Rd @@ -131,7 +131,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_errorbarh.Rd b/man/geom_errorbarh.Rd index f72ccd5a2a..21a4c79f5c 100644 --- a/man/geom_errorbarh.Rd +++ b/man/geom_errorbarh.Rd @@ -97,7 +97,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_function.Rd b/man/geom_function.Rd index 529f552d11..451c779003 100644 --- a/man/geom_function.Rd +++ b/man/geom_function.Rd @@ -100,7 +100,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_hex.Rd b/man/geom_hex.Rd index 1876bf19fe..11dbdb1f87 100644 --- a/man/geom_hex.Rd +++ b/man/geom_hex.Rd @@ -99,7 +99,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_histogram.Rd b/man/geom_histogram.Rd index a4a95c503f..1f290dbcdc 100644 --- a/man/geom_histogram.Rd +++ b/man/geom_histogram.Rd @@ -120,7 +120,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_jitter.Rd b/man/geom_jitter.Rd index 4ca3577792..2fa8acf555 100644 --- a/man/geom_jitter.Rd +++ b/man/geom_jitter.Rd @@ -108,7 +108,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 03eb82f896..0d70775f6d 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -149,7 +149,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_map.Rd b/man/geom_map.Rd index f6aaf69dca..6a634702e9 100644 --- a/man/geom_map.Rd +++ b/man/geom_map.Rd @@ -89,7 +89,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 239b7dc0c6..8c530e4d33 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -140,7 +140,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_point.Rd b/man/geom_point.Rd index b7e6a0d5d2..762d4a1f80 100644 --- a/man/geom_point.Rd +++ b/man/geom_point.Rd @@ -97,7 +97,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_polygon.Rd b/man/geom_polygon.Rd index 5e69742056..22670cbb8b 100644 --- a/man/geom_polygon.Rd +++ b/man/geom_polygon.Rd @@ -103,7 +103,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_qq.Rd b/man/geom_qq.Rd index 62ff813561..d450b3d948 100644 --- a/man/geom_qq.Rd +++ b/man/geom_qq.Rd @@ -156,7 +156,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_quantile.Rd b/man/geom_quantile.Rd index a3aa6ac3c0..568c33e970 100644 --- a/man/geom_quantile.Rd +++ b/man/geom_quantile.Rd @@ -109,7 +109,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index 418c759f8c..2c7e805fc7 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -130,7 +130,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_rug.Rd b/man/geom_rug.Rd index db5b200b76..6e84a4d985 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -108,7 +108,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_segment.Rd b/man/geom_segment.Rd index 05ecf827e8..fc3adbbd8c 100644 --- a/man/geom_segment.Rd +++ b/man/geom_segment.Rd @@ -128,7 +128,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_smooth.Rd b/man/geom_smooth.Rd index 67c0c3e0c7..6d89a61782 100644 --- a/man/geom_smooth.Rd +++ b/man/geom_smooth.Rd @@ -140,7 +140,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_spoke.Rd b/man/geom_spoke.Rd index 216686f8ec..7fe6a9d9ee 100644 --- a/man/geom_spoke.Rd +++ b/man/geom_spoke.Rd @@ -98,7 +98,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_text.Rd b/man/geom_text.Rd index 9c64a258d5..5f5dabe2d0 100644 --- a/man/geom_text.Rd +++ b/man/geom_text.Rd @@ -138,7 +138,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_tile.Rd b/man/geom_tile.Rd index ac32298ee7..326f36a2f4 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -133,7 +133,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/geom_violin.Rd b/man/geom_violin.Rd index 4041d770c7..974d1c5bdc 100644 --- a/man/geom_violin.Rd +++ b/man/geom_violin.Rd @@ -130,7 +130,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/layer.Rd b/man/layer.Rd index 8ce4e49715..b4070fbe2a 100644 --- a/man/layer.Rd +++ b/man/layer.Rd @@ -94,7 +94,9 @@ supplied parameters and aesthetics are understood by the \code{geom} or \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{key_glyph}{A legend key drawing function or a string providing the function name minus the \code{draw_key_} prefix. See \link{draw_key} for details.} diff --git a/man/layer_sf.Rd b/man/layer_sf.Rd index 8da9547aed..cda8db1d2e 100644 --- a/man/layer_sf.Rd +++ b/man/layer_sf.Rd @@ -92,7 +92,9 @@ supplied parameters and aesthetics are understood by the \code{geom} or \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} } \description{ The \code{layer_sf()} function is a variant of \code{\link[=layer]{layer()}} meant to be used by diff --git a/man/stat_ecdf.Rd b/man/stat_ecdf.Rd index d0941b2b56..8d92c51743 100644 --- a/man/stat_ecdf.Rd +++ b/man/stat_ecdf.Rd @@ -105,7 +105,9 @@ a warning. If \code{TRUE} silently removes missing values.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_ellipse.Rd b/man/stat_ellipse.Rd index bed871d361..138bda2e65 100644 --- a/man/stat_ellipse.Rd +++ b/man/stat_ellipse.Rd @@ -112,7 +112,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_identity.Rd b/man/stat_identity.Rd index 945eaafd87..f5dd6e1a5d 100644 --- a/man/stat_identity.Rd +++ b/man/stat_identity.Rd @@ -93,7 +93,9 @@ lists which parameters it can accept. \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_sf_coordinates.Rd b/man/stat_sf_coordinates.Rd index 35ce136a6c..1a8aef4440 100644 --- a/man/stat_sf_coordinates.Rd +++ b/man/stat_sf_coordinates.Rd @@ -72,7 +72,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_summary.Rd b/man/stat_summary.Rd index 83cbe4c9a7..3ebf979e54 100644 --- a/man/stat_summary.Rd +++ b/man/stat_summary.Rd @@ -161,7 +161,9 @@ to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_summary_2d.Rd b/man/stat_summary_2d.Rd index 464cdeacc3..9ee4604b65 100644 --- a/man/stat_summary_2d.Rd +++ b/man/stat_summary_2d.Rd @@ -132,7 +132,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions diff --git a/man/stat_unique.Rd b/man/stat_unique.Rd index 89a7e728b5..137c99f180 100644 --- a/man/stat_unique.Rd +++ b/man/stat_unique.Rd @@ -97,7 +97,9 @@ a warning. If \code{TRUE}, missing values are silently removed.} \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions From 19d45502557533fa03a645e34b9306e87a096b2b Mon Sep 17 00:00:00 2001 From: catalamarti Date: Thu, 15 Aug 2024 14:31:59 -0700 Subject: [PATCH 11/31] correct misleading error (#6043) --- R/utilities-break.R | 3 +++ tests/testthat/_snaps/utilities-break.md | 4 ++++ tests/testthat/test-utilities-break.R | 3 +++ 3 files changed, 10 insertions(+) create mode 100644 tests/testthat/_snaps/utilities-break.md create mode 100644 tests/testthat/test-utilities-break.R diff --git a/R/utilities-break.R b/R/utilities-break.R index 1bcce62ec3..0ed711ad7a 100644 --- a/R/utilities-break.R +++ b/R/utilities-break.R @@ -24,6 +24,9 @@ #' table(cut_width(runif(1000), 0.1, center = 0)) #' table(cut_width(runif(1000), 0.1, labels = FALSE)) cut_interval <- function(x, n = NULL, length = NULL, ...) { + if ((!is.null(n) && !is.null(length)) || (is.null(n) && is.null(length))) { + cli::cli_abort("Specify exactly one of {.var n} and {.var length}.") + } cut(x, breaks(x, "width", n, length), include.lowest = TRUE, ...) } diff --git a/tests/testthat/_snaps/utilities-break.md b/tests/testthat/_snaps/utilities-break.md new file mode 100644 index 0000000000..c8115c4c48 --- /dev/null +++ b/tests/testthat/_snaps/utilities-break.md @@ -0,0 +1,4 @@ +# cut_interval gives the correct + + Specify exactly one of `n` and `length`. + diff --git a/tests/testthat/test-utilities-break.R b/tests/testthat/test-utilities-break.R new file mode 100644 index 0000000000..23bc143a45 --- /dev/null +++ b/tests/testthat/test-utilities-break.R @@ -0,0 +1,3 @@ +test_that("cut_interval throws the correct error message", { + expect_snapshot_error(cut_interval(x = 1:10, width = 10)) +}) From 73811607903a40831d20dd239cb81c040790633f Mon Sep 17 00:00:00 2001 From: Matt Russell Date: Thu, 15 Aug 2024 22:40:46 +0100 Subject: [PATCH 12/31] Fix typo in `labeller` docs (#6034) --- R/labeller.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/labeller.R b/R/labeller.R index 3dbb9b63ac..f23f22b459 100644 --- a/R/labeller.R +++ b/R/labeller.R @@ -323,7 +323,7 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) { #' #' This function makes it easy to assign different labellers to #' different factors. The labeller can be a function or it can be a -#' named character vectors that will serve as a lookup table. +#' named character vector that will serve as a lookup table. #' #' In case of functions, if the labeller has class `labeller`, it #' is directly applied on the data frame of labels. Otherwise, it is From 308d4c32394b59009e58aef3cce1f2dd560be722 Mon Sep 17 00:00:00 2001 From: Stephen Uong <47620395+phispu@users.noreply.github.com> Date: Thu, 15 Aug 2024 15:12:51 -0700 Subject: [PATCH 13/31] `labs()`: Added `gg` class (#6045) --- NEWS.md | 1 + R/labels.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 4c0ea1e891..285399407e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Added `gg` class to `labs()` (@phispu, #5553). * Missing values from discrete palettes are no longer translated (@teunbrand, #5929). * Fixed bug in `facet_grid(margins = TRUE)` when using expresssions diff --git a/R/labels.R b/R/labels.R index 2bc5551034..7662153e91 100644 --- a/R/labels.R +++ b/R/labels.R @@ -139,7 +139,7 @@ labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(), args <- args[!duplicated(names(args))] args <- rename_aes(args) - structure(args, class = "labels") + structure(args, class = c("labels", "gg")) } #' @rdname labs From ee5c9e5b4f0ef551b00a80f3bb10060d878202bc Mon Sep 17 00:00:00 2001 From: Sierra Johnson <80361498+sierrajohnson@users.noreply.github.com> Date: Thu, 15 Aug 2024 16:16:07 -0600 Subject: [PATCH 14/31] Add translate_string_shape to GeomSf (#6039) --- NEWS.md | 1 + R/geom-sf.R | 3 +++ 2 files changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 285399407e..28ecb99196 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* geom_sf now accepts shape names (@sierrajohnson, #5808) * Added `gg` class to `labs()` (@phispu, #5553). * Missing values from discrete palettes are no longer translated (@teunbrand, #5929). diff --git a/R/geom-sf.R b/R/geom-sf.R index c6298e4b3a..457b8c272d 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -200,6 +200,9 @@ GeomSf <- ggproto("GeomSf", Geom, if (!inherits(coord, "CoordSf")) { cli::cli_abort("{.fn {snake_class(self)}} can only be used with {.fn coord_sf}.") } + if (is.character(data$shape)) { + data$shape <- translate_shape_string(data$shape) + } data <- coord$transform(data, panel_params) From 633e350f3416037432a981a345e3aa9ba25f2349 Mon Sep 17 00:00:00 2001 From: Stephen Uong <47620395+phispu@users.noreply.github.com> Date: Thu, 15 Aug 2024 15:26:02 -0700 Subject: [PATCH 15/31] `geom_function()`: x-axis title produced automatically where no data is added (#6047) --- NEWS.md | 2 ++ R/stat-function.R | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 28ecb99196..f9bdc996e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Fixed bug in `stat_function()` so x-axis title now produced automatically + when no data added. (@phispu, #5647). * geom_sf now accepts shape names (@sierrajohnson, #5808) * Added `gg` class to `labs()` (@phispu, #5553). * Missing values from discrete palettes are no longer translated diff --git a/R/stat-function.R b/R/stat-function.R index 8f31b8daba..bf6d2e4b74 100644 --- a/R/stat-function.R +++ b/R/stat-function.R @@ -50,7 +50,7 @@ stat_function <- function(mapping = NULL, data = NULL, #' @usage NULL #' @export StatFunction <- ggproto("StatFunction", Stat, - default_aes = aes(y = after_scale(y)), + default_aes = aes(x = NULL, y = after_scale(y)), compute_group = function(data, scales, fun, xlim = NULL, n = 101, args = list()) { if (is.null(scales$x)) { From d8eb945ba2b5de9d76fd137fd76101a23a0e87e1 Mon Sep 17 00:00:00 2001 From: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com> Date: Tue, 20 Aug 2024 14:19:01 +0200 Subject: [PATCH 16/31] fix some lints (#6050) --- R/annotation-logticks.R | 6 +++--- R/bin.R | 2 +- R/compat-plyr.R | 4 ++-- R/coord-polar.R | 2 +- R/coord-sf.R | 4 ++-- R/facet-.R | 2 +- R/facet-grid-.R | 4 ++-- R/facet-wrap.R | 4 ++-- R/fortify-spatial.R | 8 ++++---- R/geom-dotplot.R | 20 ++++++++++---------- R/geom-label.R | 2 +- R/geom-segment.R | 2 +- R/geom-smooth.R | 4 ++-- R/guide-.R | 4 ++-- R/guide-axis-stack.R | 4 ++-- R/guide-axis.R | 16 ++++++++-------- R/guide-bins.R | 2 +- R/guide-colorbar.R | 4 ++-- R/guide-legend.R | 2 +- R/guides-.R | 4 ++-- R/legend-draw.R | 2 +- R/limits.R | 2 +- R/margins.R | 2 +- R/plot-build.R | 16 ++++++++-------- R/position-dodge.R | 2 +- R/position-dodge2.R | 2 +- R/save.R | 2 +- R/scale-.R | 2 +- R/scale-binned.R | 2 +- R/scale-expansion.R | 2 +- R/scale-manual.R | 2 +- R/stat-bindot.R | 4 ++-- R/stat-density.R | 2 +- R/stat-ecdf.R | 2 +- R/stat-qq-line.R | 4 ++-- R/stat-smooth-methods.R | 4 ++-- R/stat-summary-bin.R | 6 +++--- R/stat-summary.R | 6 +++--- R/summarise-plot.R | 4 ++-- R/utilities-checks.R | 2 +- 40 files changed, 85 insertions(+), 85 deletions(-) diff --git a/R/annotation-logticks.R b/R/annotation-logticks.R index 33f0a952a4..13c8f609f5 100644 --- a/R/annotation-logticks.R +++ b/R/annotation-logticks.R @@ -165,7 +165,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, names(xticks)[names(xticks) == "value"] <- x_name # Rename to 'x' for coordinates$transform xticks <- coord$transform(xticks, panel_params) - xticks = xticks[xticks$x <= 1 & xticks$x >= 0,] + xticks <- xticks[xticks$x <= 1 & xticks$x >= 0,] if (outside) xticks$end = -xticks$end @@ -203,7 +203,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, names(yticks)[names(yticks) == "value"] <- y_name # Rename to 'y' for coordinates$transform yticks <- coord$transform(yticks, panel_params) - yticks = yticks[yticks$y <= 1 & yticks$y >= 0,] + yticks <- yticks[yticks$y <= 1 & yticks$y >= 0,] if (outside) yticks$end = -yticks$end @@ -238,7 +238,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom, # - start: on the other axis, start position of the line (usually 0) # - end: on the other axis, end position of the line (for example, .1, .2, or .3) calc_logticks <- function(base = 10, ticks_per_base = base - 1, - minpow = 0, maxpow = minpow + 1, start = 0, shortend = .1, midend = .2, longend = .3) { + minpow = 0, maxpow = minpow + 1, start = 0, shortend = 0.1, midend = 0.2, longend = 0.3) { # Number of blocks of tick marks reps <- maxpow - minpow diff --git a/R/bin.R b/R/bin.R index 856568f08c..a7784d02e5 100644 --- a/R/bin.R +++ b/R/bin.R @@ -165,7 +165,7 @@ bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { } # Add row for missings - if (any(is.na(bins))) { + if (anyNA(bins)) { bin_count <- c(bin_count, sum(is.na(bins))) bin_widths <- c(bin_widths, NA) bin_x <- c(bin_x, NA) diff --git a/R/compat-plyr.R b/R/compat-plyr.R index 95c317a02c..efc2865a0c 100644 --- a/R/compat-plyr.R +++ b/R/compat-plyr.R @@ -54,13 +54,13 @@ rename <- function(x, replace) { id_var <- function(x, drop = FALSE) { if (length(x) == 0) { id <- integer() - n = 0L + n <- 0L } else if (!is.null(attr(x, "n")) && !drop) { return(x) } else if (is.factor(x) && !drop) { x <- addNA(x, ifany = TRUE) id <- as.integer(x) - n <- length(levels(x)) + n <- nlevels(x) } else { levels <- sort(unique0(x), na.last = TRUE) id <- match(x, levels) diff --git a/R/coord-polar.R b/R/coord-polar.R index e0712760fb..f1c8108ddf 100644 --- a/R/coord-polar.R +++ b/R/coord-polar.R @@ -137,7 +137,7 @@ CoordPolar <- ggproto("CoordPolar", Coord, ret[[n]]$sec.labels <- out$sec.labels } - details = list( + details <- list( x.range = ret$x$range, y.range = ret$y$range, x.major = ret$x$major, y.major = ret$y$major, x.minor = ret$x$minor, y.minor = ret$y$minor, diff --git a/R/coord-sf.R b/R/coord-sf.R index f861ae2d28..a14b3c718c 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -416,7 +416,7 @@ sf_rescale01 <- function(x, x_range, y_range) { # different limits methods calc_limits_bbox <- function(method, xlim, ylim, crs, default_crs) { - if (any(!is.finite(c(xlim, ylim))) && method != "geometry_bbox") { + if (!all(is.finite(c(xlim, ylim))) && method != "geometry_bbox") { cli::cli_abort(c( "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}." @@ -585,7 +585,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, } parse_axes_labeling <- function(x) { - labs = unlist(strsplit(x, "")) + labs <- unlist(strsplit(x, "")) list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4]) } diff --git a/R/facet-.R b/R/facet-.R index 96c96dc6fd..359c19a248 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -678,7 +678,7 @@ find_panel <- function(table) { } #' @rdname find_panel #' @export -panel_cols = function(table) { +panel_cols <- function(table) { panels <- table$layout[grepl("^panel", table$layout$name), , drop = FALSE] unique0(panels[, c('l', 'r')]) } diff --git a/R/facet-grid-.R b/R/facet-grid-.R index 7bfb30dd6e..c51df5c138 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -319,8 +319,8 @@ FacetGrid <- ggproto("FacetGrid", Facet, if (length(missing_facets) > 0) { to_add <- unique0(layout[missing_facets]) - data_rep <- rep.int(1:nrow(data), nrow(to_add)) - facet_rep <- rep(1:nrow(to_add), each = nrow(data)) + data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add)) + facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data)) data <- unrowname(data[data_rep, , drop = FALSE]) facet_vals <- unrowname(vec_cbind( diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 68c02f0b21..93ae19da91 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -242,8 +242,8 @@ FacetWrap <- ggproto("FacetWrap", Facet, to_add <- unique0(layout[missing_facets]) - data_rep <- rep.int(1:nrow(data), nrow(to_add)) - facet_rep <- rep(1:nrow(to_add), each = nrow(data)) + data_rep <- rep.int(seq_len(nrow(data)), nrow(to_add)) + facet_rep <- rep(seq_len(nrow(to_add)), each = nrow(data)) data <- data[data_rep, , drop = FALSE] facet_vals <- vec_cbind( diff --git a/R/fortify-spatial.R b/R/fortify-spatial.R index 6fe7392a37..0e9f37d046 100644 --- a/R/fortify-spatial.R +++ b/R/fortify-spatial.R @@ -71,7 +71,7 @@ fortify.Polygons <- function(model, data, ...) { }) pieces <- vec_rbind0(!!!pieces) - pieces$order <- 1:nrow(pieces) + pieces$order <- seq_len(nrow(pieces)) pieces$id <- model@ID pieces$piece <- factor(pieces$piece) pieces$group <- interaction(pieces$id, pieces$piece) @@ -89,7 +89,7 @@ fortify.Polygon <- function(model, data, ...) { df <- as.data.frame(model@coords) names(df) <- c("long", "lat") - df$order <- 1:nrow(df) + df$order <- seq_len(nrow(df)) df$hole <- model@hole df } @@ -124,7 +124,7 @@ fortify.Lines <- function(model, data, ...) { }) pieces <- vec_rbind0(!!!pieces) - pieces$order <- 1:nrow(pieces) + pieces$order <- seq_len(nrow(pieces)) pieces$id <- model@ID pieces$piece <- factor(pieces$piece) pieces$group <- interaction(pieces$id, pieces$piece) @@ -142,7 +142,7 @@ fortify.Line <- function(model, data, ...) { df <- as.data.frame(model@coords) names(df) <- c("long", "lat") - df$order <- 1:nrow(df) + df$order <- seq_len(nrow(df)) df } diff --git a/R/geom-dotplot.R b/R/geom-dotplot.R index e163fb272b..7a0f9a5e08 100644 --- a/R/geom-dotplot.R +++ b/R/geom-dotplot.R @@ -197,25 +197,25 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, # Set up the stacking function and range if (is.null(params$stackdir) || params$stackdir == "up") { - stackdots <- function(a) a - .5 + stackdots <- function(a) a - 0.5 stackaxismin <- 0 stackaxismax <- 1 } else if (params$stackdir == "down") { - stackdots <- function(a) -a + .5 + stackdots <- function(a) -a + 0.5 stackaxismin <- -1 stackaxismax <- 0 } else if (params$stackdir == "center") { stackdots <- function(a) a - 1 - max(a - 1) / 2 - stackaxismin <- -.5 - stackaxismax <- .5 + stackaxismin <- -0.5 + stackaxismax <- 0.5 } else if (params$stackdir == "centerwhole") { stackdots <- function(a) a - 1 - floor(max(a - 1) / 2) - stackaxismin <- -.5 - stackaxismax <- .5 + stackaxismin <- -0.5 + stackaxismax <- 0.5 } # Fill the bins: at a given x (or y), if count=3, make 3 entries at that x - data <- data[rep(1:nrow(data), data$count), ] + data <- data[rep(seq_len(nrow(data)), data$count), ] # Next part will set the position of each dot within each stack # If stackgroups=TRUE, split only on x (or y) and panel; if not stacking, also split by group @@ -231,7 +231,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, # Within each x, or x+group, set countidx=1,2,3, and set stackpos according to stack function data <- dapply(data, plyvars, function(xx) { - xx$countidx <- 1:nrow(xx) + xx$countidx <- seq_len(nrow(xx)) xx$stackpos <- stackdots(xx$countidx) xx }) @@ -281,11 +281,11 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, binaxis <- ifelse(binaxis == "x", "y", "x") if (binaxis == "x") { - stackaxis = "y" + stackaxis <- "y" dotdianpc <- dotsize * tdata$binwidth[1] / (max(panel_params$x.range) - min(panel_params$x.range)) } else if (binaxis == "y") { - stackaxis = "x" + stackaxis <- "x" dotdianpc <- dotsize * tdata$binwidth[1] / (max(panel_params$y.range) - min(panel_params$y.range)) } diff --git a/R/geom-label.R b/R/geom-label.R index e8a4605b54..a265850f91 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -81,7 +81,7 @@ GeomLabel <- ggproto("GeomLabel", Geom, size.unit <- resolve_text_unit(size.unit) - grobs <- lapply(1:nrow(data), function(i) { + grobs <- lapply(seq_len(nrow(data)), function(i) { row <- data[i, , drop = FALSE] labelGrob(lab[i], x = unit(row$x, "native"), diff --git a/R/geom-segment.R b/R/geom-segment.R index be3492bb56..303a040337 100644 --- a/R/geom-segment.R +++ b/R/geom-segment.R @@ -134,7 +134,7 @@ GeomSegment <- ggproto("GeomSegment", Geom, )) } - data$group <- 1:nrow(data) + data$group <- seq_len(nrow(data)) starts <- subset(data, select = c(-xend, -yend)) ends <- rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y")) diff --git a/R/geom-smooth.R b/R/geom-smooth.R index 2247bf2a5b..8874ef491c 100644 --- a/R/geom-smooth.R +++ b/R/geom-smooth.R @@ -153,8 +153,8 @@ GeomSmooth <- ggproto("GeomSmooth", Geom, ribbon <- transform(data, colour = NA) path <- transform(data, alpha = NA) - ymin = flipped_names(flipped_aes)$ymin - ymax = flipped_names(flipped_aes)$ymax + ymin <- flipped_names(flipped_aes)$ymin + ymax <- flipped_names(flipped_aes)$ymax has_ribbon <- se && !is.null(data[[ymax]]) && !is.null(data[[ymin]]) gList( diff --git a/R/guide-.R b/R/guide-.R index 0a334c4580..1856394ee3 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -487,7 +487,7 @@ Guide <- ggproto( # Helper function that may facilitate flipping theme elements by # swapping x/y related arguments to `element_grob()` -flip_element_grob = function(..., flip = FALSE) { +flip_element_grob <- function(..., flip = FALSE) { if (!flip) { ans <- element_grob(...) return(ans) @@ -499,7 +499,7 @@ flip_element_grob = function(..., flip = FALSE) { } # The flippable arguments for `flip_element_grob()`. -flip_names = c( +flip_names <- c( "x" = "y", "y" = "x", "width" = "height", diff --git a/R/guide-axis-stack.R b/R/guide-axis-stack.R index c645c29d99..b11a969b8f 100644 --- a/R/guide-axis-stack.R +++ b/R/guide-axis-stack.R @@ -41,7 +41,7 @@ guide_axis_stack <- function(first = "axis", ..., title = waiver(), theme = NULL # 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)) { + if (!any(available)) { cli::cli_abort(paste0( "{.fn guide_axis_stack} can only use guides that handle {.field x} and ", "{.field y} aesthetics." @@ -49,7 +49,7 @@ guide_axis_stack <- function(first = "axis", ..., title = waiver(), theme = NULL } # Remove guides that don't support x/y aesthetics - if (any(!available)) { + if (!all(available)) { remove <- which(!available) removed <- vapply(axes[remove], snake_class, character(1)) axes[remove] <- NULL diff --git a/R/guide-axis.R b/R/guide-axis.R index dc57ffd23e..a0f1fb5ce3 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -592,23 +592,23 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { if (axis_position == "bottom") { - hjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0 - vjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1 + hjust <- if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0 + vjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1 } else if (axis_position == "left") { - hjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1 - vjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1 + hjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1 + vjust <- if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1 } else if (axis_position == "top") { - hjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1 - vjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0 + hjust <- if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1 + vjust <- if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0 } else if (axis_position == "right") { - 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 + 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 } diff --git a/R/guide-bins.R b/R/guide-bins.R index e2bd0db428..518655cbba 100644 --- a/R/guide-bins.R +++ b/R/guide-bins.R @@ -326,7 +326,7 @@ GuideBins <- ggproto( } ) -parse_binned_breaks = function(scale, breaks = scale$get_breaks()) { +parse_binned_breaks <- function(scale, breaks = scale$get_breaks()) { breaks <- breaks[!is.na(breaks)] if (length(breaks) == 0) { diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index ca63f29b54..5154c67c07 100644 --- a/R/guide-colorbar.R +++ b/R/guide-colorbar.R @@ -366,12 +366,12 @@ GuideColourbar <- ggproto( if (params$direction == "horizontal") { width <- 1 / nrow(decor) height <- 1 - x <- (seq(nrow(decor)) - 1) * width + x <- (seq_len(nrow(decor)) - 1) * width y <- 0 } else { width <- 1 height <- 1 / nrow(decor) - y <- (seq(nrow(decor)) - 1) * height + y <- (seq_len(nrow(decor)) - 1) * height x <- 0 } grob <- rectGrob( diff --git a/R/guide-legend.R b/R/guide-legend.R index 95dba1cfa0..6e3524b5bd 100644 --- a/R/guide-legend.R +++ b/R/guide-legend.R @@ -631,7 +631,7 @@ keep_key_data <- function(key, data, aes, show) { if (isTRUE(any(show)) || length(show) == 0) { return(TRUE) } - if (isTRUE(all(!show))) { + if (isTRUE(!any(show))) { return(FALSE) } # Second, we go find if the value is actually present in the data. diff --git a/R/guides-.R b/R/guides-.R index fc9d6e2b3c..d45f55e892 100644 --- a/R/guides-.R +++ b/R/guides-.R @@ -194,7 +194,7 @@ Guides <- ggproto( if (is.character(index)) { index <- match(index, self$aesthetics) } - if (any(is.na(index)) || length(index) == 0) { + if (anyNA(index) || length(index) == 0) { return(NULL) } if (length(index) == 1) { @@ -209,7 +209,7 @@ Guides <- ggproto( if (is.character(index)) { index <- match(index, self$aesthetics) } - if (any(is.na(index)) || length(index) == 0) { + if (anyNA(index) || length(index) == 0) { return(NULL) } if (length(index) == 1) { diff --git a/R/legend-draw.R b/R/legend-draw.R index 9bfd1d9d93..ccfb035872 100644 --- a/R/legend-draw.R +++ b/R/legend-draw.R @@ -207,7 +207,7 @@ draw_key_vpath <- function(data, params, size) { #' @export #' @rdname draw_key draw_key_dotplot <- function(data, params, size) { - pointsGrob(0.5, 0.5, size = unit(.5, "npc"), + pointsGrob(0.5, 0.5, size = unit(0.5, "npc"), pch = 21, gp = gg_par( col = alpha(data$colour %||% "black", data$alpha), diff --git a/R/limits.R b/R/limits.R index 26528ee7ff..087c4c11d0 100644 --- a/R/limits.R +++ b/R/limits.R @@ -116,7 +116,7 @@ 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) } - if (!any(is.na(lims)) && lims[1] > lims[2]) { + if (!anyNA(lims) && lims[1] > lims[2]) { trans <- "reverse" } else { trans <- "identity" diff --git a/R/margins.R b/R/margins.R index 0fee3ca0ab..176072b4de 100644 --- a/R/margins.R +++ b/R/margins.R @@ -198,7 +198,7 @@ justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, ) } else { - children = gList(grobs) + children <- gList(grobs) } diff --git a/R/plot-build.R b/R/plot-build.R index 2a68dd550f..23d2a11b0f 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -250,18 +250,18 @@ ggplot_gtable.ggplot_built <- function(data) { pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), , drop = FALSE] if (title_pos == "panel") { - title_l = min(pans$l) - title_r = max(pans$r) + title_l <- min(pans$l) + title_r <- max(pans$r) } else { - title_l = 1 - title_r = ncol(plot_table) + title_l <- 1 + title_r <- ncol(plot_table) } if (caption_pos == "panel") { - caption_l = min(pans$l) - caption_r = max(pans$r) + caption_l <- min(pans$l) + caption_r <- max(pans$r) } else { - caption_l = 1 - caption_r = ncol(plot_table) + caption_l <- 1 + caption_r <- ncol(plot_table) } plot_table <- gtable_add_rows(plot_table, subtitle_height, pos = 0) diff --git a/R/position-dodge.R b/R/position-dodge.R index b3818cf08c..ec4b64cdad 100644 --- a/R/position-dodge.R +++ b/R/position-dodge.R @@ -175,7 +175,7 @@ pos_dodge <- function(df, width, n = NULL) { groupidx <- match(df$group, unique0(df$group)) # Find the center for each group, then use that to calculate xmin and xmax - df$x <- df$x + width * ((groupidx - 0.5) / n - .5) + df$x <- df$x + width * ((groupidx - 0.5) / n - 0.5) df$xmin <- df$x - d_width / n / 2 df$xmax <- df$x + d_width / n / 2 diff --git a/R/position-dodge2.R b/R/position-dodge2.R index e8e291c62c..a670ffc349 100644 --- a/R/position-dodge2.R +++ b/R/position-dodge2.R @@ -113,7 +113,7 @@ pos_dodge2 <- function(df, width, n = NULL, padding = 0.1) { df$x <- (df$xmin + df$xmax) / 2 # If no elements occupy the same position, there is no need to add padding - if (!any(duplicated(df$xid))) { + if (!anyDuplicated(df$xid) > 0) { return(df) } diff --git a/R/save.R b/R/save.R index 2f28c49418..acc4176162 100644 --- a/R/save.R +++ b/R/save.R @@ -197,7 +197,7 @@ plot_dim <- function(dim = c(NA, NA), scale = 1, units = "in", dim <- to_inches(dim) * scale - if (any(is.na(dim))) { + if (anyNA(dim)) { if (length(grDevices::dev.list()) == 0) { default_dim <- c(7, 7) } else { diff --git a/R/scale-.R b/R/scale-.R index 1773f15142..fd0bbd444f 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -123,7 +123,7 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam position <- arg_match0(position, c("left", "right", "top", "bottom")) # If the scale is non-positional, break = NULL means removing the guide - if (is.null(breaks) && all(!is_position_aes(aesthetics))) { + if (is.null(breaks) && !any(is_position_aes(aesthetics))) { guide <- "none" } diff --git a/R/scale-binned.R b/R/scale-binned.R index d84080fdef..4db4f1a916 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -92,7 +92,7 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, include.lowest = TRUE, right = self$right ) - (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] + (x - x_binned + 0.5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] } else { x <- as.numeric(self$oob(x, limits)) x <- ifelse(!is.na(x), x, self$na.value) diff --git a/R/scale-expansion.R b/R/scale-expansion.R index 8ec72c2a78..e3392fc5bf 100644 --- a/R/scale-expansion.R +++ b/R/scale-expansion.R @@ -69,7 +69,7 @@ expand_range4 <- function(limits, expand) { cli::cli_abort("{.arg expand} must be a numeric vector with 2 or 4 elements.") } - if (all(!is.finite(limits))) { + if (!any(is.finite(limits))) { return(c(-Inf, Inf)) } diff --git a/R/scale-manual.R b/R/scale-manual.R index 6e96a54c3b..bcd0624094 100644 --- a/R/scale-manual.R +++ b/R/scale-manual.R @@ -176,7 +176,7 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), if (length(breaks) <= length(values)) { names(values) <- breaks } else { - names(values) <- breaks[1:length(values)] + names(values) <- breaks[seq_along(values)] } } diff --git a/R/stat-bindot.R b/R/stat-bindot.R index 66e40ce6cb..85eecc4d54 100644 --- a/R/stat-bindot.R +++ b/R/stat-bindot.R @@ -143,14 +143,14 @@ densitybin <- function(x, weight = NULL, binwidth = NULL, method = method, range # Sort weight and x, by x weight <- weight[order(x)] - x <- x[order(x)] + x <- sort(x, na.last = TRUE) cbin <- 0 # Current bin ID bin <- rep.int(NA, length(x)) # The bin ID for each observation binend <- -Inf # End position of current bin (scan left to right) # Scan list and put dots in bins - for (i in 1:length(x)) { + for (i in seq_along(x)) { # If past end of bin, start a new bin at this point if (x[i] >= binend) { binend <- x[i] + binwidth diff --git a/R/stat-density.R b/R/stat-density.R index add18570fc..5b948f5d88 100644 --- a/R/stat-density.R +++ b/R/stat-density.R @@ -239,7 +239,7 @@ reflect_density <- function(dens, bounds, from, to) { # Similar to stats::density.default # Once R4.3.0 is the lowest supported version, this function can be replaced by # using `density(..., warnWbw = FALSE)`. -precompute_bw = function(x, bw = "nrd0") { +precompute_bw <- function(x, bw = "nrd0") { bw <- bw[1] if (is.character(bw)) { bw <- to_lower_ascii(bw) diff --git a/R/stat-ecdf.R b/R/stat-ecdf.R index 85287b9130..96430b1e32 100644 --- a/R/stat-ecdf.R +++ b/R/stat-ecdf.R @@ -147,7 +147,7 @@ wecdf <- function(x, weights = NULL) { x <- x[ord] weights <- weights[ord] - if (any(!is.finite(weights))) { + if (!all(is.finite(weights))) { cli::cli_warn(c(paste0( "The {.field weight} aesthetic does not support non-finite or ", "{.code NA} values." diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index 67b0da407d..8133216779 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -11,7 +11,7 @@ geom_qq_line <- function(mapping = NULL, ..., distribution = stats::qnorm, dparams = list(), - line.p = c(.25, .75), + line.p = c(0.25, 0.75), fullrange = FALSE, na.rm = FALSE, show.legend = NA, @@ -56,7 +56,7 @@ StatQqLine <- ggproto("StatQqLine", Stat, distribution = stats::qnorm, dparams = list(), na.rm = FALSE, - line.p = c(.25, .75), + line.p = c(0.25, 0.75), fullrange = FALSE) { sample <- sort(data$sample) diff --git a/R/stat-smooth-methods.R b/R/stat-smooth-methods.R index 77d50cdff3..dc90e3c457 100644 --- a/R/stat-smooth-methods.R +++ b/R/stat-smooth-methods.R @@ -60,7 +60,7 @@ predictdf.loess <- function(model, xseq, se, level) { if (se) { y <- pred$fit - ci <- pred$se.fit * stats::qt(level / 2 + .5, pred$df) + ci <- pred$se.fit * stats::qt(level / 2 + 0.5, pred$df) ymin <- y - ci ymax <- y + ci base::data.frame(x = xseq, y, ymin, ymax, se = pred$se.fit) @@ -79,7 +79,7 @@ predictdf.locfit <- function(model, xseq, se, level) { if (se) { y <- pred$fit - ci <- pred$se.fit * stats::qt(level / 2 + .5, model$dp["df2"]) + ci <- pred$se.fit * stats::qt(level / 2 + 0.5, model$dp["df2"]) ymin <- y - ci ymax <- y + ci base::data.frame(x = xseq, y, ymin, ymax, se = pred$se.fit) diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index ce57b6def9..e9cd675e09 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -23,15 +23,15 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, fun.ymax = deprecated()) { if (lifecycle::is_present(fun.y)) { deprecate_warn0("3.3.0", "stat_summary_bin(fun.y)", "stat_summary_bin(fun)") - fun = fun %||% fun.y + fun <- fun %||% fun.y } if (lifecycle::is_present(fun.ymin)) { deprecate_warn0("3.3.0", "stat_summary_bin(fun.ymin)", "stat_summary_bin(fun.min)") - fun.min = fun.min %||% fun.ymin + fun.min <- fun.min %||% fun.ymin } if (lifecycle::is_present(fun.ymax)) { deprecate_warn0("3.3.0", "stat_summary_bin(fun.ymax)", "stat_summary_bin(fun.max)") - fun.max = fun.max %||% fun.ymax + fun.max <- fun.max %||% fun.ymax } layer( data = data, diff --git a/R/stat-summary.R b/R/stat-summary.R index ddcb7b5ae3..cf2e2ef4c7 100644 --- a/R/stat-summary.R +++ b/R/stat-summary.R @@ -143,15 +143,15 @@ stat_summary <- function(mapping = NULL, data = NULL, fun.ymax = deprecated()) { if (lifecycle::is_present(fun.y)) { deprecate_warn0("3.3.0", "stat_summary(fun.y)", "stat_summary(fun)") - fun = fun %||% fun.y + fun <- fun %||% fun.y } if (lifecycle::is_present(fun.ymin)) { deprecate_warn0("3.3.0", "stat_summary(fun.ymin)", "stat_summary(fun.min)") - fun.min = fun.min %||% fun.ymin + fun.min <- fun.min %||% fun.ymin } if (lifecycle::is_present(fun.ymax)) { deprecate_warn0("3.3.0", "stat_summary(fun.ymax)", "stat_summary(fun.max)") - fun.max = fun.max %||% fun.ymax + fun.max <- fun.max %||% fun.ymax } layer( data = data, diff --git a/R/summarise-plot.R b/R/summarise-plot.R index 9411c1c586..bdb7cc7af4 100644 --- a/R/summarise-plot.R +++ b/R/summarise-plot.R @@ -61,7 +61,7 @@ NULL #' @rdname summarise_plot #' @export -summarise_layout = function(p) { +summarise_layout <- function(p) { check_inherits(p, "ggplot_built") l <- p$layout @@ -98,7 +98,7 @@ summarise_layout = function(p) { #' @rdname summarise_plot #' @export -summarise_coord = function(p) { +summarise_coord <- function(p) { check_inherits(p, "ggplot_built") # Given a transform object, find the log base; if the transform object is diff --git a/R/utilities-checks.R b/R/utilities-checks.R index db5fee2353..a1ed1b5091 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -182,7 +182,7 @@ check_inherits <- function(x, #' #' # Possibly throw an error #' try(check_device("glyphs", action = "abort")) -check_device = function(feature, action = "warn", op = NULL, maybe = FALSE, +check_device <- function(feature, action = "warn", op = NULL, maybe = FALSE, call = caller_env()) { check_bool(maybe, allow_na = TRUE) From 1a6e4958d9730f1d71bdd1261dde0aa52a6b90b2 Mon Sep 17 00:00:00 2001 From: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com> Date: Tue, 20 Aug 2024 14:53:00 +0200 Subject: [PATCH 17/31] Fix some lints in the `tests` folder (#6051) * fix more lints * revert any(duplicated()) changes --- tests/testthat/test-aes-calculated.R | 2 +- tests/testthat/test-aes-grouping.R | 2 +- tests/testthat/test-coord-.R | 3 +- tests/testthat/test-coord-polar.R | 4 +- tests/testthat/test-coord-train.R | 6 +- tests/testthat/test-coord_sf.R | 4 +- tests/testthat/test-empty-data.R | 6 +- tests/testthat/test-facet-strips.R | 18 ++--- tests/testthat/test-fortify.R | 2 +- tests/testthat/test-geom-dotplot.R | 86 +++++++++++----------- tests/testthat/test-geom-path.R | 8 +- tests/testthat/test-geom-rug.R | 18 ++--- tests/testthat/test-geom-sf.R | 12 +-- tests/testthat/test-geom-violin.R | 10 +-- tests/testthat/test-guides.R | 8 +- tests/testthat/test-layer.R | 2 +- tests/testthat/test-scale-type.R | 4 +- tests/testthat/test-scales-breaks-labels.R | 52 ++++++------- tests/testthat/test-scales.R | 4 +- tests/testthat/test-sec-axis.R | 8 +- tests/testthat/test-stat-density.R | 2 +- tests/testthat/test-stat-function.R | 4 +- tests/testthat/test-stat-ydensity.R | 4 +- tests/testthat/test-stats.R | 4 +- tests/testthat/test-theme.R | 14 ++-- tests/testthat/test-utilities.R | 16 ++-- 26 files changed, 151 insertions(+), 152 deletions(-) diff --git a/tests/testthat/test-aes-calculated.R b/tests/testthat/test-aes-calculated.R index 62d25697d3..b453af02f5 100644 --- a/tests/testthat/test-aes-calculated.R +++ b/tests/testthat/test-aes-calculated.R @@ -6,7 +6,7 @@ test_that("names surrounded by .. is calculated", { expect_equal(is_calculated_aes(aes(..x.., ..x, x..)), c(TRUE, FALSE, FALSE)) # even when nested - expect_equal(is_calculated_aes(aes(f(..x..))), TRUE) + expect_true(is_calculated_aes(aes(f(..x..)))) }) test_that("call to stat() is calculated", { diff --git a/tests/testthat/test-aes-grouping.R b/tests/testthat/test-aes-grouping.R index bea15e2630..d5536cc417 100644 --- a/tests/testthat/test-aes-grouping.R +++ b/tests/testthat/test-aes-grouping.R @@ -26,7 +26,7 @@ test_that("no error for aes(groupS)", { g <- add_group(df2) expect_equal(nrow(g), nrow(df2)) - expect_equal(names(g), c("x", "y", "groupS", "group")) + expect_named(g, c("x", "y", "groupS", "group")) }) test_that("label is not used as a grouping var", { diff --git a/tests/testthat/test-coord-.R b/tests/testthat/test-coord-.R index b372478981..76a174454c 100644 --- a/tests/testthat/test-coord-.R +++ b/tests/testthat/test-coord-.R @@ -37,8 +37,7 @@ test_that("guide names are not removed by `train_panel_guides()`", { layout$setup_panel_guides(guides_list(NULL), plot$layers) # Line showing change in outcome - expect_equal(names(layout$panel_params[[1]]$guides$aesthetics), - c("x", "y", "x.sec", "y.sec")) + expect_named(layout$panel_params[[1]]$guides$aesthetics, c("x", "y", "x.sec", "y.sec")) }) test_that("check coord limits errors only on bad inputs", { diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index a663a43d98..e9cdcc4813 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -1,7 +1,7 @@ test_that("polar distance is calculated correctly", { dat <- data_frame( theta = c(0, 2*pi, 2, 6, 6, 1, 1, 0), - r = c(0, 0, 0.5, 0.5, 1, 1, 0.75, .5)) + r = c(0, 0, 0.5, 0.5, 1, 1, 0.75, 0.5)) scales <- list( x = scale_x_continuous(limits = c(0, 2*pi)), @@ -176,7 +176,7 @@ test_that("polar coordinates draw correctly", { dat <- data_frame( theta = c(0, 2*pi, 2, 6, 6, 1, 1, 0), - r = c(0, 0, 0.5, 0.5, 1, 1, 0.75, .5), + r = c(0, 0, 0.5, 0.5, 1, 1, 0.75, 0.5), g = 1:8 ) expect_doppelganger("Rays, circular arcs, and spiral arcs", diff --git a/tests/testthat/test-coord-train.R b/tests/testthat/test-coord-train.R index b326fc6fe1..9d42ec3c79 100644 --- a/tests/testthat/test-coord-train.R +++ b/tests/testthat/test-coord-train.R @@ -5,7 +5,7 @@ test_that("NA's don't appear in breaks", { ns <- names(trained)[grepl("(\\.major)|(\\.minor)$", names(trained))] for (n in ns) { - if (!is.null(trained[n]) && any(is.na(trained[n]))) + if (!is.null(trained[n]) && anyNA(trained[n])) return(TRUE) } @@ -19,8 +19,8 @@ test_that("NA's don't appear in breaks", { # This is a test to make sure the later tests will be useful! # It's possible that changes to the way that breaks are calculated will # make it so that scale_break_positions will no longer give NA for range 1, 12 - expect_true(any(is.na(scale_x$break_positions()))) - expect_true(any(is.na(scale_y$break_positions()))) + expect_true(anyNA(scale_x$break_positions())) + expect_true(anyNA(scale_y$break_positions())) # Check the various types of coords to make sure they don't have NA breaks expect_false(any_NA_major_minor(coord_polar()$setup_panel_params(scale_x, scale_y))) diff --git a/tests/testthat/test-coord_sf.R b/tests/testthat/test-coord_sf.R index c668b3ec79..12a667be5b 100644 --- a/tests/testthat/test-coord_sf.R +++ b/tests/testthat/test-coord_sf.R @@ -309,8 +309,8 @@ test_that("sf_transform_xy() works", { # transform back out2 <- sf_transform_xy(out, 4326, 3347) expect_identical(data$city, out2$city) - expect_true(all(abs(out2$x - data$x) < .01)) - expect_true(all(abs(out2$y - data$y) < .01)) + expect_true(all(abs(out2$x - data$x) < 0.01)) + expect_true(all(abs(out2$y - data$y) < 0.01)) }) diff --git a/tests/testthat/test-empty-data.R b/tests/testthat/test-empty-data.R index 3d7c27c52d..bdcc02003c 100644 --- a/tests/testthat/test-empty-data.R +++ b/tests/testthat/test-empty-data.R @@ -88,13 +88,13 @@ test_that("empty layers still generate one grob per panel", { geom_point() + facet_wrap(~y) - expect_equal(length(get_layer_grob(d)), 3) + expect_length(get_layer_grob(d), 3) }) test_that("missing layers generate one grob per panel", { df <- data_frame(x = 1:4, y = rep(1:2, 2), g = rep(1:2, 2)) base <- ggplot(df, aes(x, y)) + geom_point(shape = NA, na.rm = TRUE) - expect_equal(length(get_layer_grob(base)), 1) - expect_equal(length(get_layer_grob(base + facet_wrap(~ g))), 2) + expect_length(get_layer_grob(base), 1) + expect_length(get_layer_grob(base + facet_wrap(~ g)), 2) }) diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R index c2f131191e..d13f8d500c 100644 --- a/tests/testthat/test-facet-strips.R +++ b/tests/testthat/test-facet-strips.R @@ -143,16 +143,16 @@ 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), 19) - expect_equal(length(pg$widths), 18) + expect_length(pg$heights, 19) + expect_length(pg$widths, 18) pg <- ggplotGrob( p + scale_x_continuous(position = "top") + scale_y_continuous(position = "right") ) - expect_equal(length(pg$heights), 20) + expect_length(pg$heights, 20) expect_equal(as.character(pg$heights[9]), "1cm") - expect_equal(length(pg$widths), 19) + expect_length(pg$widths, 19) expect_equal(as.character(pg$widths[13]), "1cm") # Also add padding with negative ticks and no text (#5251) @@ -160,7 +160,7 @@ test_that("padding is only added if axis is present", { p + scale_x_continuous(labels = NULL, position = "top") + theme(axis.ticks.length.x.top = unit(-2, "mm")) ) - expect_equal(length(pg$heights), 20) + expect_length(pg$heights, 20) expect_equal(as.character(pg$heights[9]), "1cm") # Inverse should be true when strips are switched @@ -172,17 +172,17 @@ test_that("padding is only added if axis is present", { ) pg <- ggplotGrob(p) - expect_equal(length(pg$heights), 20) + expect_length(pg$heights, 20) expect_equal(as.character(pg$heights[13]), "1cm") - expect_equal(length(pg$widths), 19) + expect_length(pg$widths, 19) expect_equal(as.character(pg$widths[7]), "1cm") pg <- ggplotGrob( p + scale_x_continuous(position = "top") + scale_y_continuous(position = "right") ) - expect_equal(length(pg$heights), 19) - expect_equal(length(pg$widths), 18) + expect_length(pg$heights, 19) + expect_length(pg$widths, 18) }) test_that("y strip labels are rotated when strips are switched", { diff --git a/tests/testthat/test-fortify.R b/tests/testthat/test-fortify.R index 03980c19c1..3a48c76ba0 100644 --- a/tests/testthat/test-fortify.R +++ b/tests/testthat/test-fortify.R @@ -11,7 +11,7 @@ test_that("spatial polygons have correct ordering", { y - dely,y - dely,y + dely,y + dely,y - dely), ncol = 2)) } - make_hole <- function(x = 0, y = 0, height = .5, width = .5){ + make_hole <- function(x = 0, y = 0, height = 0.5, width = 0.5){ p <- make_square(x = x, y = y, height = height, width = width) p@hole <- TRUE p diff --git a/tests/testthat/test-geom-dotplot.R b/tests/testthat/test-geom-dotplot.R index 3cf61d4216..648c52f926 100644 --- a/tests/testthat/test-geom-dotplot.R +++ b/tests/testthat/test-geom-dotplot.R @@ -17,7 +17,7 @@ test_that("dodging works", { ndodge <- 3 # The amount of space allocated within each dodge group - dwidth <- .9 / ndodge + dwidth <- 0.9 / ndodge # This should be the x position for each before dodging xbase <- ceiling(df$group / ndodge) @@ -36,20 +36,20 @@ test_that("dodging works", { test_that("binning works", { bp <- ggplot(dat, aes(y)) + - geom_dotplot(binwidth = .4, method = "histodot") + geom_dotplot(binwidth = 0.4, method = "histodot") x <- get_layer_data(bp)$x # Need ugly hack to make sure mod function doesn't give values like -3.99999 # due to floating point error - expect_true(all(abs((x - min(x) + 1e-7) %% .4) < 1e-6)) + expect_true(all(abs((x - min(x) + 1e-7) %% 0.4) < 1e-6)) bp <- ggplot(dat, aes(x = y)) + - geom_dotplot(binwidth = .4, method = "dotdensity") + geom_dotplot(binwidth = 0.4, method = "dotdensity") x <- get_layer_data(bp)$x # This one doesn't ensure that dotdensity works, but it does check that it's not # doing fixed bin sizes - expect_false(all(abs((x - min(x) + 1e-7) %% .4) < 1e-6)) + expect_false(all(abs((x - min(x) + 1e-7) %% 0.4) < 1e-6)) }) test_that("NA's result in warning from stat_bindot", { @@ -58,7 +58,7 @@ test_that("NA's result in warning from stat_bindot", { dat$x[c(2,10)] <- NA # Need to assign it to a var here so that it doesn't automatically print - expect_snapshot_warning(ggplot_build(ggplot(dat, aes(x)) + geom_dotplot(binwidth = .2))) + expect_snapshot_warning(ggplot_build(ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.2))) }) test_that("when binning on y-axis, limits depend on the panel", { @@ -92,99 +92,99 @@ test_that("geom_dotplot draws correctly", { # Basic dotplot with binning along x axis expect_doppelganger("basic dotplot with dot-density binning, binwidth = .4", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4) + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4) ) expect_doppelganger("histodot binning (equal bin spacing)", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, method = "histodot") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, method = "histodot") ) expect_doppelganger("dots stacked closer: stackratio=.5, fill=white", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackratio = .5, fill = "white") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackratio = 0.5, fill = "white") ) expect_doppelganger("larger dots: dotsize=1.5, fill=white", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, dotsize = 1.4, fill = "white") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, dotsize = 1.4, fill = "white") ) # Stacking methods expect_doppelganger("stack up", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "up") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "up") ) expect_doppelganger("stack down", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "down") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "down") ) expect_doppelganger("stack center", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "center") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "center") ) expect_doppelganger("stack centerwhole", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "centerwhole") + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "centerwhole") ) # Stacking methods with coord_flip expect_doppelganger("stack up with coord_flip", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "up") + coord_flip() + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "up") + coord_flip() ) expect_doppelganger("stack down with coord_flip", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "down") + coord_flip() + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "down") + coord_flip() ) expect_doppelganger("stack center with coord_flip", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "center") + coord_flip() + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "center") + coord_flip() ) expect_doppelganger("stack centerwhole with coord_flip", - ggplot(dat, aes(x)) + geom_dotplot(binwidth = .4, stackdir = "centerwhole") + coord_flip() + ggplot(dat, aes(x)) + geom_dotplot(binwidth = 0.4, stackdir = "centerwhole") + coord_flip() ) # Binning along x, with groups expect_doppelganger("multiple groups, bins not aligned", - ggplot(dat, aes(x, fill = g)) + geom_dotplot(binwidth = .4, alpha = .4) + ggplot(dat, aes(x, fill = g)) + geom_dotplot(binwidth = 0.4, alpha = 0.4) ) expect_doppelganger("multiple groups, bins aligned", - ggplot(dat, aes(x, fill = g)) + geom_dotplot(binwidth = .4, alpha = .4, binpositions = "all") + ggplot(dat, aes(x, fill = g)) + geom_dotplot(binwidth = 0.4, alpha = 0.4, binpositions = "all") ) # Binning along y axis expect_doppelganger("bin along y, stack center", - ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = .4, binaxis = "y", stackdir = "center") + ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = 0.4, binaxis = "y", stackdir = "center") ) expect_doppelganger("bin along y, stack centerwhole", - ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = .4, binaxis = "y", stackdir = "centerwhole") + ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = 0.4, binaxis = "y", stackdir = "centerwhole") ) expect_doppelganger("bin along y, stack centerwhole, histodot", - ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = .4, binaxis = "y", stackdir = "centerwhole", method = "histodot") + ggplot(dat, aes(0, x)) + geom_dotplot(binwidth = 0.4, binaxis = "y", stackdir = "centerwhole", method = "histodot") ) # Binning along y, with multiple grouping factors dat2 <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90), g = rep(factor(LETTERS[1:2]), 45)) expect_doppelganger("bin x, three y groups, stack centerwhole", - ggplot(dat2, aes(y, x)) + geom_dotplot(binwidth = .25, binaxis = "x", stackdir = "centerwhole") + ggplot(dat2, aes(y, x)) + geom_dotplot(binwidth = 0.25, binaxis = "x", stackdir = "centerwhole") ) expect_doppelganger("bin y, three x groups, stack centerwhole", - ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = .25, binaxis = "y", stackdir = "centerwhole") + ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = 0.25, binaxis = "y", stackdir = "centerwhole") ) expect_doppelganger("bin y, three x groups, bins aligned across groups", - ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = .25, binaxis = "y", stackdir = "center", binpositions = "all") + ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = 0.25, binaxis = "y", stackdir = "center", binpositions = "all") ) expect_doppelganger("bin y, three x groups, bins aligned, coord_flip", - ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = .25, binaxis = "y", stackdir = "center", binpositions = "all") + + ggplot(dat2, aes(x, y)) + geom_dotplot(binwidth = 0.25, binaxis = "y", stackdir = "center", binpositions = "all") + coord_flip() ) expect_doppelganger("bin y, dodged", - ggplot(dat2, aes("foo", y, fill = x)) + scale_y_continuous(breaks = seq(-4, 4, .4)) + - geom_dotplot(binwidth = .25, position = "dodge", binaxis = "y", stackdir = "center") + ggplot(dat2, aes("foo", y, fill = x)) + scale_y_continuous(breaks = seq(-4, 4, 0.4)) + + geom_dotplot(binwidth = 0.25, position = "dodge", binaxis = "y", stackdir = "center") ) expect_doppelganger("bin y, dodged, coord_flip", - ggplot(dat2, aes("foo", y, fill = x)) + scale_y_continuous(breaks = seq(-4, 4, .4)) + - geom_dotplot(binwidth = .25, position = "dodge", binaxis = "y", stackdir = "center") + + ggplot(dat2, aes("foo", y, fill = x)) + scale_y_continuous(breaks = seq(-4, 4, 0.4)) + + geom_dotplot(binwidth = 0.25, position = "dodge", binaxis = "y", stackdir = "center") + coord_flip() ) expect_doppelganger("bin y, three x groups, fill and dodge", - ggplot(dat2, aes(x, y, fill = g)) + scale_y_continuous(breaks = seq(-4 ,4, .4)) + - geom_dotplot(binwidth = .2, position = "dodge", binaxis = "y", stackdir = "center") + ggplot(dat2, aes(x, y, fill = g)) + scale_y_continuous(breaks = seq(-4 ,4, 0.4)) + + geom_dotplot(binwidth = 0.2, position = "dodge", binaxis = "y", stackdir = "center") ) expect_doppelganger("bin y, continous x-axis, grouping by x", - ggplot(dat2, aes(as.numeric(x), y, group = x)) + geom_dotplot(binwidth = .2, binaxis = "y", stackdir = "center") + ggplot(dat2, aes(as.numeric(x), y, group = x)) + geom_dotplot(binwidth = 0.2, binaxis = "y", stackdir = "center") ) expect_doppelganger("bin y, continous x-axis, single x group", - ggplot(dat2, aes(as.numeric(x), y)) + geom_dotplot(binwidth = .2, binaxis = "y", stackdir = "center") + ggplot(dat2, aes(as.numeric(x), y)) + geom_dotplot(binwidth = 0.2, binaxis = "y", stackdir = "center") ) # border width and size @@ -198,31 +198,31 @@ test_that("geom_dotplot draws correctly", { stroke = rep(c(1, 2), length.out = nrow(dat)) ) ) + - geom_dotplot(binwidth = .4, fill = "red", col = "blue") + + geom_dotplot(binwidth = 0.4, fill = "red", col = "blue") + continuous_scale("stroke", palette = function(x) scales::rescale(x, to = c(1, 6))) + guides(linetype = guide_legend(order = 1)) ) # Stacking groups expect_doppelganger("3 stackgroups, dot-density with aligned bins", - ggplot(dat2, aes(y, fill = x)) + geom_dotplot(binwidth = .25, stackgroups = TRUE, binpositions = "all", alpha = 0.5) + ggplot(dat2, aes(y, fill = x)) + geom_dotplot(binwidth = 0.25, stackgroups = TRUE, binpositions = "all", alpha = 0.5) ) expect_doppelganger("3 stackgroups, histodot", - ggplot(dat2, aes(y, fill = x)) + geom_dotplot(binwidth = .25, stackgroups = TRUE, method = "histodot", alpha = 0.5) + ggplot(dat2, aes(y, fill = x)) + geom_dotplot(binwidth = 0.25, stackgroups = TRUE, method = "histodot", alpha = 0.5) ) expect_doppelganger("3 stackgroups, bin y, histodot", - ggplot(dat2, aes(1, y, fill = x)) + geom_dotplot(binaxis = "y", binwidth = .25, stackgroups = TRUE, method = "histodot", alpha = 0.5) + ggplot(dat2, aes(1, y, fill = x)) + geom_dotplot(binaxis = "y", binwidth = 0.25, stackgroups = TRUE, method = "histodot", alpha = 0.5) ) # This one is currently broken but it would be a really rare case, and it # probably requires a really ugly hack to fix expect_doppelganger("bin y, dodging, 3 stackgroups, histodot", ggplot(dat2, aes(x, y, fill = g)) + - geom_dotplot(binaxis = "y", binwidth = .25, stackgroups = TRUE, method = "histodot", + geom_dotplot(binaxis = "y", binwidth = 0.25, stackgroups = TRUE, method = "histodot", alpha = 0.5, stackdir = "centerwhole") ) expect_doppelganger("facets, 3 groups, histodot, stackgroups", - ggplot(dat2, aes(y, fill = g)) + geom_dotplot(binwidth = .25, stackgroups = TRUE, method = "histodot", alpha = 0.5) + + ggplot(dat2, aes(y, fill = g)) + geom_dotplot(binwidth = 0.25, stackgroups = TRUE, method = "histodot", alpha = 0.5) + facet_grid(x ~ .) ) @@ -231,10 +231,10 @@ test_that("geom_dotplot draws correctly", { dat2$x[c(1, 10)] <- NA expect_warning(expect_doppelganger("2 NA values, dot-density binning, binwidth = .4", - ggplot(dat2, aes(x)) + geom_dotplot(binwidth = .4) + ggplot(dat2, aes(x)) + geom_dotplot(binwidth = 0.4) )) expect_warning(expect_doppelganger("2 NA values, bin along y, stack center", - ggplot(dat2, aes(0, x)) + geom_dotplot(binwidth = .4, binaxis = "y", stackdir = "center") + ggplot(dat2, aes(0, x)) + geom_dotplot(binwidth = 0.4, binaxis = "y", stackdir = "center") )) }) diff --git a/tests/testthat/test-geom-path.R b/tests/testthat/test-geom-path.R index 6cf55aece9..3255a2f4cb 100644 --- a/tests/testthat/test-geom-path.R +++ b/tests/testthat/test-geom-path.R @@ -1,8 +1,8 @@ test_that("keep_mid_true drops leading/trailing FALSE", { - expect_equal(keep_mid_true(c(F, F)), c(F, F)) - expect_equal(keep_mid_true(c(F, T, F, T, F)), c(F, T, T, T, F)) - expect_equal(keep_mid_true(c(T, T, F, T, F)), c(T, T, T, T, F)) - expect_equal(keep_mid_true(c(F, T, F, T, T)), c(F, T, T, T, T)) + expect_equal(keep_mid_true(c(FALSE, FALSE)), c(FALSE, FALSE)) + expect_equal(keep_mid_true(c(FALSE, TRUE, FALSE, TRUE, FALSE)), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_equal(keep_mid_true(c(TRUE, TRUE, FALSE, TRUE, FALSE)), c(TRUE, TRUE, TRUE, TRUE, FALSE)) + expect_equal(keep_mid_true(c(FALSE, TRUE, FALSE, TRUE, TRUE)), c(FALSE, TRUE, TRUE, TRUE, TRUE)) }) test_that("geom_path() throws meaningful error on bad combination of varying aesthetics", { diff --git a/tests/testthat/test-geom-rug.R b/tests/testthat/test-geom-rug.R index 28aa17efcb..7539a494a6 100644 --- a/tests/testthat/test-geom-rug.R +++ b/tests/testthat/test-geom-rug.R @@ -1,4 +1,4 @@ -n = 10 +n <- 10 df <- data_frame(x = 1:n, y = (1:n)^3) p <- ggplot(df, aes(x, y)) + geom_point() + geom_rug(sides = 'l') @@ -7,16 +7,16 @@ test_that("coord_flip flips the rugs", { b <- get_layer_grob(p + coord_flip(), 2) # Rugs along y-axis, all x coordinates are the same - expect_equal(length(a[[1]]$children[[1]]$x0), 1) - expect_equal(length(a[[1]]$children[[1]]$x1), 1) - expect_equal(length(a[[1]]$children[[1]]$y0), n) - expect_equal(length(a[[1]]$children[[1]]$y1), n) + expect_length(a[[1]]$children[[1]]$x0, 1) + expect_length(a[[1]]$children[[1]]$x1, 1) + expect_length(a[[1]]$children[[1]]$y0, n) + expect_length(a[[1]]$children[[1]]$y1, n) # Rugs along x-axis, all y coordinates are the same - expect_equal(length(b[[1]]$children[[1]]$x0), n) - expect_equal(length(b[[1]]$children[[1]]$x1), n) - expect_equal(length(b[[1]]$children[[1]]$y0), 1) - expect_equal(length(b[[1]]$children[[1]]$y1), 1) + expect_length(b[[1]]$children[[1]]$x0, n) + expect_length(b[[1]]$children[[1]]$x1, n) + expect_length(b[[1]]$children[[1]]$y0, 1) + expect_length(b[[1]]$children[[1]]$y1, 1) }) test_that("Rug length needs unit object", { diff --git a/tests/testthat/test-geom-sf.R b/tests/testthat/test-geom-sf.R index fac4c8b87a..e52a13e917 100644 --- a/tests/testthat/test-geom-sf.R +++ b/tests/testthat/test-geom-sf.R @@ -30,23 +30,23 @@ test_that("geom_sf() determines the legend type automatically", { } # test the automatic choice - expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mp, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "point") - expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mls, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "line") - expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mpol, TRUE)$plot$layers[[1]]$computed_geom_params$legend, "other") # test that automatic choice can be overridden manually - expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mp, "point")$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mp, "point")$plot$layers[[1]]$computed_geom_params$legend, "point") - expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mls, "point")$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mls, "point")$plot$layers[[1]]$computed_geom_params$legend, "point") - expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$show.legend, TRUE) + expect_true(fun_geom_sf(mpol, "point")$plot$layers[[1]]$show.legend) expect_identical(fun_geom_sf(mpol, "point")$plot$layers[[1]]$computed_geom_params$legend, "point") }) diff --git a/tests/testthat/test-geom-violin.R b/tests/testthat/test-geom-violin.R index eabbc5c95c..7d73c04e94 100644 --- a/tests/testthat/test-geom-violin.R +++ b/tests/testthat/test-geom-violin.R @@ -43,7 +43,7 @@ test_that("quantiles do not fail on zero-range data", { p <- ggplot(zero.range.data) + geom_violin(aes(1, y), draw_quantiles = 0.5) # This should return without error and have length one - expect_equal(length(get_layer_grob(p)), 1) + expect_length(get_layer_grob(p), 1) }) test_that("quantiles fails outside 0-1 bound", { @@ -81,7 +81,7 @@ test_that("quantiles do not issue warning", { test_that("geom_violin draws correctly", { set.seed(111) dat <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90)) - dat <- dat[dat$x != "C" | c(T, F),] # Keep half the C's + dat <- dat[dat$x != "C" | c(TRUE, FALSE),] # Keep half the C's expect_doppelganger("basic", ggplot(dat, aes(x = x, y = y)) + geom_violin() @@ -90,13 +90,13 @@ test_that("geom_violin draws correctly", { ggplot(dat, aes(x = x, y = y)) + geom_violin(scale = "count"), ) expect_doppelganger("narrower (width=.5)", - ggplot(dat, aes(x = x, y = y)) + geom_violin(width = .5) + ggplot(dat, aes(x = x, y = y)) + geom_violin(width = 0.5) ) expect_doppelganger("with tails and points", ggplot(dat, aes(x = x, y = y)) + geom_violin(trim = FALSE) + geom_point(shape = 21) ) expect_doppelganger("with smaller bandwidth and points", - ggplot(dat, aes(x = x, y = y)) + geom_violin(adjust = .3) + geom_point(shape = 21) + ggplot(dat, aes(x = x, y = y)) + geom_violin(adjust = 0.3) + geom_point(shape = 21) ) expect_doppelganger("dodging", ggplot(dat, aes(x = "foo", y = y, fill = x)) + geom_violin() @@ -126,6 +126,6 @@ test_that("geom_violin draws correctly", { ) expect_doppelganger("grouping on x and fill, dodge width = 0.5", ggplot(dat2, aes(x = x, y = y, fill = g)) + - geom_violin(position = position_dodge(width = .5)) + geom_violin(position = position_dodge(width = 0.5)) ) }) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index a2e5ae918d..f0057a7452 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -44,7 +44,7 @@ test_that("colourbar trains without labels", { sc <- scale_colour_continuous(limits = c(0, 4), labels = NULL) out <- g$train(scale = sc) - expect_equal(names(out$key), c("colour", ".value")) + expect_named(out$key, c("colour", ".value")) }) test_that("Colorbar respects show.legend in layer", { @@ -213,7 +213,7 @@ test_that("guide merging for guide_legend() works as expected", { }) test_that("size = NA doesn't throw rendering errors", { - df = data.frame( + df <- data.frame( x = c(1, 2), group = c("a","b") ) @@ -903,7 +903,7 @@ test_that("guides are positioned correctly", { p2 <- p2 + theme(legend.position = "inside") # Placement of legend inside expect_doppelganger("legend inside plot, centered", - p2 + theme(legend.position.inside = c(.5, .5)) + p2 + theme(legend.position.inside = c(0.5, 0.5)) ) expect_doppelganger("legend inside plot, bottom left", p2 + theme(legend.justification = c(0,0), legend.position.inside = c(0,0)) @@ -912,7 +912,7 @@ test_that("guides are positioned correctly", { 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.inside = c(.5,.5)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(0.5,0.5)) ) }) diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 0a89af1da8..ea7f9c8c60 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -80,7 +80,7 @@ test_that("if an aes is mapped to a function that returns NULL, it is removed", df <- data_frame(x = 1:10) null <- function(...) NULL p <- cdata(ggplot(df, aes(x, null()))) - expect_identical(names(p[[1]]), c("x", "PANEL", "group")) + expect_named(p[[1]], c("x", "PANEL", "group")) }) test_that("layers are stateless except for the computed params", { diff --git a/tests/testthat/test-scale-type.R b/tests/testthat/test-scale-type.R index 4be2fe9ebf..3ca1f06637 100644 --- a/tests/testthat/test-scale-type.R +++ b/tests/testthat/test-scale-type.R @@ -1,9 +1,9 @@ test_that("no scale for NULL aesthetic", { - expect_equal(find_scale("colour", NULL), NULL) + expect_null(find_scale("colour", NULL)) }) test_that("no scale for Inf aesthetic", { - expect_equal(find_scale("colour", Inf), NULL) + expect_null(find_scale("colour", Inf)) }) test_that("message + continuous for unknown type", { diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index d24e0ab638..c3a314cacc 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -47,9 +47,9 @@ test_that("out-of-range breaks are dropped", { # Limits are specified, and all breaks are out of range sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)], limits = c(2, 4)) bi <- sc$break_info() - expect_equal(length(bi$labels), 0) - expect_equal(length(bi$major), 0) - expect_equal(length(bi$major_source), 0) + expect_length(bi$labels, 0) + expect_length(bi$major, 0) + expect_length(bi$major_source, 0) # limits aren't specified, automatic labels # limits are set by the data @@ -72,36 +72,36 @@ test_that("out-of-range breaks are dropped", { sc <- scale_x_continuous(breaks = c(1,5), labels = letters[c(1,5)]) sc$train_df(data_frame(x = 2:4)) bi <- sc$break_info() - expect_equal(length(bi$labels), 0) - expect_equal(length(bi$major), 0) - expect_equal(length(bi$major_source), 0) + expect_length(bi$labels, 0) + expect_length(bi$major, 0) + expect_length(bi$major_source, 0) }) test_that("no minor breaks when only one break", { sc1 <- scale_x_discrete(limits = "a") sc2 <- scale_x_continuous(limits = 1) - expect_equal(length(sc1$get_breaks_minor()), 0) - expect_equal(length(sc2$get_breaks_minor()), 0) + expect_length(sc1$get_breaks_minor(), 0) + expect_length(sc2$get_breaks_minor(), 0) }) init_scale <- function(...) { sc <- scale_x_discrete(...) sc$train(factor(1:100)) - expect_equal(length(sc$get_limits()), 100) + expect_length(sc$get_limits(), 100) sc } test_that("discrete labels match breaks", { sc <- init_scale(breaks = 0:5 * 10) - expect_equal(length(sc$get_breaks()), 5) - expect_equal(length(sc$get_labels()), 5) + expect_length(sc$get_breaks(), 5) + expect_length(sc$get_labels(), 5) expect_equal(sc$get_labels(), sc$get_breaks(), ignore_attr = TRUE) sc <- init_scale(breaks = 0:5 * 10, labels = letters[1:6]) - expect_equal(length(sc$get_breaks()), 5) - expect_equal(length(sc$get_labels()), 5) + expect_length(sc$get_breaks(), 5) + expect_length(sc$get_labels(), 5) expect_equal(sc$get_labels(), letters[2:6]) sc <- init_scale(breaks = 0:5 * 10, labels = @@ -110,8 +110,8 @@ test_that("discrete labels match breaks", { pick_5 <- function(x) sample(x, 5) sc <- init_scale(breaks = pick_5) - expect_equal(length(sc$get_breaks()), 5) - expect_equal(length(sc$get_labels()), 5) + expect_length(sc$get_breaks(), 5) + expect_length(sc$get_labels(), 5) }) test_that("scale breaks work with numeric log transformation", { @@ -141,30 +141,30 @@ test_that("passing continuous limits to a discrete scale generates a warning", { }) test_that("suppressing breaks, minor_breask, and labels works", { - expect_equal(scale_x_continuous(breaks = NULL, limits = c(1, 3))$get_breaks(), NULL) - expect_equal(scale_x_discrete(breaks = NULL, limits = c("one", "three"))$get_breaks(), NULL) - expect_equal(scale_x_continuous(minor_breaks = NULL, limits = c(1, 3))$get_breaks_minor(), NULL) + expect_null(scale_x_continuous(breaks = NULL, limits = c(1, 3))$get_breaks()) + expect_null(scale_x_discrete(breaks = NULL, limits = c("one", "three"))$get_breaks()) + expect_null(scale_x_continuous(minor_breaks = NULL, limits = c(1, 3))$get_breaks_minor()) - expect_equal(scale_x_continuous(labels = NULL, limits = c(1, 3))$get_labels(), NULL) - expect_equal(scale_x_discrete(labels = NULL, limits = c("one", "three"))$get_labels(), NULL) + expect_null(scale_x_continuous(labels = NULL, limits = c(1, 3))$get_labels()) + expect_null(scale_x_discrete(labels = NULL, limits = c("one", "three"))$get_labels()) # date, datetime lims <- as.Date(c("2000/1/1", "2000/2/1")) - expect_equal(scale_x_date(breaks = NULL, limits = lims)$get_breaks(), NULL) + expect_null(scale_x_date(breaks = NULL, limits = lims)$get_breaks()) # NA is defunct, should throw error expect_error(scale_x_date(breaks = NA, limits = lims)$get_breaks()) - expect_equal(scale_x_date(labels = NULL, limits = lims)$get_labels(), NULL) + expect_null(scale_x_date(labels = NULL, limits = lims)$get_labels()) expect_error(scale_x_date(labels = NA, limits = lims)$get_labels()) - expect_equal(scale_x_date(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) + expect_null(scale_x_date(minor_breaks = NULL, limits = lims)$get_breaks_minor()) expect_error(scale_x_date(minor_breaks = NA, limits = lims)$get_breaks_minor()) # date, datetime lims <- as.POSIXct(c("2000/1/1 0:0:0", "2010/1/1 0:0:0")) - expect_equal(scale_x_datetime(breaks = NULL, limits = lims)$get_breaks(), NULL) + expect_null(scale_x_datetime(breaks = NULL, limits = lims)$get_breaks()) expect_error(scale_x_datetime(breaks = NA, limits = lims)$get_breaks()) - expect_equal(scale_x_datetime(labels = NULL, limits = lims)$get_labels(), NULL) + expect_null(scale_x_datetime(labels = NULL, limits = lims)$get_labels()) expect_error(scale_x_datetime(labels = NA, limits = lims)$get_labels()) - expect_equal(scale_x_datetime(minor_breaks = NULL, limits = lims)$get_breaks_minor(), NULL) + expect_null(scale_x_datetime(minor_breaks = NULL, limits = lims)$get_breaks_minor()) expect_error(scale_x_datetime(minor_breaks = NA, limits = lims)$get_breaks_minor()) }) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 4e104f9024..0ba2989e39 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -2,10 +2,10 @@ test_that("building a plot does not affect its scales", { dat <- data_frame(x = rnorm(20), y = rnorm(20)) p <- ggplot(dat, aes(x, y)) + geom_point() - expect_equal(length(p$scales$scales), 0) + expect_length(p$scales$scales, 0) ggplot_build(p) - expect_equal(length(p$scales$scales), 0) + expect_length(p$scales$scales, 0) }) test_that("ranges update only for variables listed in aesthetics", { diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index 2b8fde0d94..56a788b469 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -242,7 +242,7 @@ test_that("sec_axis() respects custom transformations", { expect_doppelganger( "sec_axis, custom transform", ggplot(dat, aes(x = x, y = y)) + - geom_line(linewidth = 1, na.rm = T) + + geom_line(linewidth = 1, na.rm = TRUE) + scale_y_continuous( transform = magnify_trans_log(interval_low = 0.5, interval_high = 1, reducer = 0.5, reducer2 = 8), breaks = @@ -364,21 +364,21 @@ test_that("sec_axis() works for power transformations (monotonicity test doesn't scale_y_continuous(sec.axis = sec_axis(transform = ~ .^0.5)) scale <- get_panel_scales(p)$y breaks <- scale$break_info() - expect_equal(breaks$major, sqrt(breaks$sec.major), tolerance = .005) + expect_equal(breaks$major, sqrt(breaks$sec.major), tolerance = 0.005) p <- ggplot(foo, aes(x, y)) + geom_point() + scale_x_sqrt(sec.axis = dup_axis()) scale <- get_panel_scales(p)$x breaks <- scale$break_info() - expect_equal(breaks$major, breaks$sec.major, tolerance = .001) + expect_equal(breaks$major, breaks$sec.major, tolerance = 0.001) p <- ggplot(foo, aes(x, y)) + geom_point() + scale_x_sqrt(sec.axis = sec_axis(~ . * 100)) scale <- get_panel_scales(p)$x breaks <- scale$break_info() - expect_equal(breaks$major, breaks$sec.major, tolerance = .001) + expect_equal(breaks$major, breaks$sec.major, tolerance = 0.001) }) test_that("discrete scales can have secondary axes", { diff --git a/tests/testthat/test-stat-density.R b/tests/testthat/test-stat-density.R index 5f2ec3adb8..0894fc2944 100644 --- a/tests/testthat/test-stat-density.R +++ b/tests/testthat/test-stat-density.R @@ -123,7 +123,7 @@ test_that("compute_density returns useful df and throws warning when <2 values", expect_warning(dens <- compute_density(1, NULL, from = 0, to = 0)) expect_equal(nrow(dens), 1) - expect_equal(names(dens), c("x", "density", "scaled", "ndensity", "count", "wdensity", "n")) + expect_named(dens, c("x", "density", "scaled", "ndensity", "count", "wdensity", "n")) expect_type(dens$x, "double") }) diff --git a/tests/testthat/test-stat-function.R b/tests/testthat/test-stat-function.R index 4025dcca96..483578d97f 100644 --- a/tests/testthat/test-stat-function.R +++ b/tests/testthat/test-stat-function.R @@ -18,8 +18,8 @@ test_that("uses scale limits, not data limits", { expect_equal(ret$y[c(1, 101)], ret_log$y[c(1, 101)]) expect_equal(range(ret$x), c(0.1, 100)) expect_equal(range(ret_log$x), c(-1, 2)) - expect_false(any(is.na(ret$y))) - expect_false(any(is.na(ret_log$y))) + expect_false(anyNA(ret$y)) + expect_false(anyNA(ret_log$y)) }) test_that("works in plots without any data", { diff --git a/tests/testthat/test-stat-ydensity.R b/tests/testthat/test-stat-ydensity.R index d9f39b4708..3b70fc7673 100644 --- a/tests/testthat/test-stat-ydensity.R +++ b/tests/testthat/test-stat-ydensity.R @@ -17,13 +17,13 @@ test_that("`drop = FALSE` preserves groups with 1 observations", { ld <- get_layer_data(p + geom_violin(drop = TRUE)), "Groups with fewer than two datapoints have been dropped" ) - expect_equal(length(unique(ld$x)), 3) + expect_length(unique(ld$x), 3) expect_warning( ld <- get_layer_data(p + geom_violin(drop = FALSE)), "Cannot compute density for groups with fewer than two datapoints" ) - expect_equal(length(unique(ld$x)), 4) + expect_length(unique(ld$x), 4) }) test_that("mapped_discrete class is preserved", { diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R index b1acda601e..0739f78a6d 100644 --- a/tests/testthat/test-stats.R +++ b/tests/testthat/test-stats.R @@ -3,12 +3,12 @@ test_that("plot succeeds even if some computation fails", { p1 <- ggplot(df, aes(x, y)) + geom_point() b1 <- ggplot_build(p1) - expect_equal(length(b1$data), 1) + expect_length(b1$data, 1) p2 <- p1 + stat_summary(fun = function(x) stop("Failed computation")) expect_warning(b2 <- ggplot_build(p2), "Computation failed") - expect_equal(length(b2$data), 2) + expect_length(b2$data, 2) }) test_that("error message is thrown when aesthetics are missing", { diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index a9568cfd72..03f2a11d48 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -412,7 +412,7 @@ test_that("current theme can be updated with new elements", { ) # theme calculation for nonexisting element returns NULL - expect_identical(calc_element("abcde", plot_theme(b1)), NULL) + expect_null(calc_element("abcde", plot_theme(b1))) # element tree gets merged properly register_theme_elements( @@ -730,12 +730,12 @@ test_that("axes ticks can have independent lengths", { scale_x_continuous(sec.axis = dup_axis()) + scale_y_continuous(sec.axis = dup_axis()) + theme( - axis.ticks.length.x.top = unit(-.5, "cm"), - axis.ticks.length.x.bottom = unit(-.25, "cm"), - axis.ticks.length.y.left = unit(.25, "cm"), - axis.ticks.length.y.right = unit(.5, "cm"), - axis.text.x.bottom = element_text(margin = margin(t = .25, unit = "cm")), - axis.text.x.top = element_text(margin = margin(b = .25, unit = "cm")) + axis.ticks.length.x.top = unit(-0.5, "cm"), + axis.ticks.length.x.bottom = unit(-0.25, "cm"), + axis.ticks.length.y.left = unit(0.25, "cm"), + axis.ticks.length.y.right = unit(0.5, "cm"), + axis.text.x.bottom = element_text(margin = margin(t = 0.25, unit = "cm")), + axis.text.x.top = element_text(margin = margin(b = 0.25, unit = "cm")) ) expect_doppelganger("ticks_length", plot) }) diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 4537b03210..08e948ca82 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -2,14 +2,14 @@ test_that("finite_cases.data.frame", { finite_cases <- function(x) cases(x, is_finite) # All finite -------------------------------------------------------------- - expect_identical(finite_cases(data_frame(x = 4)), TRUE) # 1x1 - expect_identical(finite_cases(data_frame(x = 4, y = 11)), TRUE) # 1x2 + expect_true(finite_cases(data_frame(x = 4))) # 1x1 + expect_true(finite_cases(data_frame(x = 4, y = 11))) # 1x2 expect_identical(finite_cases(data_frame(x = 4:5)), c(TRUE, TRUE)) # 2x1 expect_identical(finite_cases(data_frame(x = 4:5, y = 11:12)), c(TRUE, TRUE)) # 2x2 # Has one NA -------------------------------------------------------------- - expect_identical(finite_cases(data_frame(x = NA)), FALSE) # 1x1 - expect_identical(finite_cases(data_frame(x = 4, y = NA)), FALSE) # 1x2 + expect_false(finite_cases(data_frame(x = NA))) # 1x1 + expect_false(finite_cases(data_frame(x = 4, y = NA))) # 1x2 expect_identical(finite_cases(data_frame(x = c(4, NA))), c(TRUE, FALSE)) # 2x1 expect_identical(finite_cases(data_frame(x = c(4, NA), y = c(11, NA))), c(TRUE, FALSE)) # 2x2 expect_identical(finite_cases(data_frame(x = c(4, NA), y = c(NA, 12))), c(FALSE, FALSE)) # 2x2 @@ -17,7 +17,7 @@ test_that("finite_cases.data.frame", { # Testing NaN and Inf, using miscellaneous data shapes -------------------- expect_identical(finite_cases(data_frame(x = c(4, NaN))), c(TRUE, FALSE)) - expect_identical(finite_cases(data_frame(x = Inf)), FALSE) + expect_false(finite_cases(data_frame(x = Inf))) expect_identical(finite_cases(data_frame(x = c(4, 5), y = c(-Inf, 12))), c(FALSE, TRUE)) }) @@ -87,7 +87,7 @@ test_that("parse_safe works with multi expressions", { }) test_that("x and y aesthetics have the same length", { - expect_equal(length(ggplot_global$x_aes), length(ggplot_global$y_aes)) + expect_length(ggplot_global$x_aes, length(ggplot_global$y_aes)) }) test_that("check_required_aesthetics() errors on missing", { @@ -189,8 +189,8 @@ test_that("expose/ignore_data() can round-trip a data.frame", { # 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")) + expect_named(test, c("a", "c", ".ignored")) + expect_named(test$.ignored, c("b", "d")) test <- .expose_data(test)[[1]] expect_equal(test, df[, c("a", "c", "b", "d")]) From 2071c97098104379e10504fafc04117713bda96c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 20 Aug 2024 15:00:16 +0200 Subject: [PATCH 18/31] Axis alignment over multiple panels (#5826) * Don't fix viewport size * add null padding * Fix viewport size, but flexibly * add test * add news bullet --- NEWS.md | 1 + R/guide-axis.R | 18 ++- .../facet-labels/outside-justified-labels.svg | 144 ++++++++++++++++++ tests/testthat/test-facet-labels.R | 27 ++++ 4 files changed, 189 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/_snaps/facet-labels/outside-justified-labels.svg diff --git a/NEWS.md b/NEWS.md index f9bdc996e0..807e9a00fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Axis labels are now justified across facet panels (@teunbrand, #5820) * Fixed bug in `stat_function()` so x-axis title now produced automatically when no data added. (@phispu, #5647). * geom_sf now accepts shape names (@sierrajohnson, #5808) diff --git a/R/guide-axis.R b/R/guide-axis.R index a0f1fb5ce3..8280219f3d 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -424,6 +424,7 @@ GuideAxis <- ggproto( # Unlist the 'label' grobs z <- if (params$position == "left") c(2, 1, 3) else 1:3 z <- rep(z, c(1, length(grobs$labels), 1)) + has_labels <- !is.zero(grobs$labels[[1]]) grobs <- c(list(grobs$ticks), grobs$labels, list(grobs$title)) # Initialise empty gtable @@ -445,10 +446,25 @@ GuideAxis <- ggproto( vp <- exec( viewport, !!params$orth_aes := unit(params$orth_side, "npc"), - !!params$orth_size := params$measure_gtable(gt), + !!params$orth_size := max(params$measure_gtable(gt), unit(1, "npc")), just = params$opposite ) + # Add null-unit padding to justify based on eventual gtable cell shape + # rather than dimensions of this axis alone. + if (has_labels && params$position %in% c("left", "right")) { + where <- layout$l[-c(1, length(layout$l))] + just <- with(elements$text, rotate_just(angle, hjust, vjust))$hjust %||% 0.5 + gt <- gtable_add_cols(gt, unit(just, "null"), pos = min(where) - 1) + gt <- gtable_add_cols(gt, unit(1 - just, "null"), pos = max(where) + 1) + } + if (has_labels && params$position %in% c("top", "bottom")) { + where <- layout$t[-c(1, length(layout$t))] + just <- with(elements$text, rotate_just(angle, hjust, vjust))$vjust %||% 0.5 + gt <- gtable_add_rows(gt, unit(1 - just, "null"), pos = min(where) - 1) + gt <- gtable_add_rows(gt, unit(just, "null"), pos = max(where) + 1) + } + # Assemble with axis line absoluteGrob( gList(axis_line, gt), diff --git a/tests/testthat/_snaps/facet-labels/outside-justified-labels.svg b/tests/testthat/_snaps/facet-labels/outside-justified-labels.svg new file mode 100644 index 0000000000..9b04f0b614 --- /dev/null +++ b/tests/testthat/_snaps/facet-labels/outside-justified-labels.svg @@ -0,0 +1,144 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +C + + + + + + + + + + +D + + + + + + + + + + +A + + + + + + + + + + +B + + + +X +X +X +X +X + +X + +X +X +X +X +X + +X +YYYYY + +Y + + +YYYYY + +Y +x +y +outside-justified labels + + diff --git a/tests/testthat/test-facet-labels.R b/tests/testthat/test-facet-labels.R index 6d086e0b7b..c8613bc978 100644 --- a/tests/testthat/test-facet-labels.R +++ b/tests/testthat/test-facet-labels.R @@ -157,3 +157,30 @@ test_that("parsed labels are rendered correctly", { facet_wrap(~ f, labeller = label_parsed) ) }) + +test_that("outside-justified labels are justified across panels", { + + df <- data.frame( + x = c("X\nX\nX\nX\nX", "X"), + y = c("YYYYY", "Y"), + f1 = c("A", "B"), + f2 = c("C", "D") + ) + + # By default, axis labels are inside-justified so it doesn't matter whether + # justification occurs across panels. This changes for outside-justification. + # See #5820 + + p <- ggplot(df, aes(x, y)) + + geom_point() + + facet_grid(f1 ~ f2, scales = "free") + + guides(x.sec = "axis", y.sec = "axis") + + theme( + axis.text.y.left = element_text(hjust = 0), + axis.text.y.right = element_text(hjust = 1), + axis.text.x.top = element_text(vjust = 1), + axis.text.x.bottom = element_text(vjust = 0) + ) + + expect_doppelganger("outside-justified labels", p) +}) From 995b40cca6d9906acd09748b9bd3da9b0d0cba1f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 20 Aug 2024 15:31:33 +0200 Subject: [PATCH 19/31] Move coord clipping responsibility from facet to coord (#5953) * move panel assembly to coord * move panel clipping responsibility from facets to coords * coord_radial uses clipping path * only apply clipping mask when possibly supported * add news bullet * turn on strip clipping by default * remove superfluous `clip` argument * add another bullet * reminder for the future --- NEWS.md | 7 ++ R/coord-.R | 14 ++++ R/coord-radial.R | 21 +++++ R/facet-.R | 7 +- R/facet-grid-.R | 8 +- R/facet-null.R | 3 +- R/facet-wrap.R | 2 +- R/layout.R | 15 +--- R/theme-defaults.R | 6 +- ...et-wrap-with-omitted-inner-axis-labels.svg | 77 +++++++++++++------ ...sitioned-correctly-in-non-table-layout.svg | 36 --------- tests/testthat/test-coord-polar.R | 3 + 12 files changed, 111 insertions(+), 88 deletions(-) diff --git a/NEWS.md b/NEWS.md index 807e9a00fd..3408f12b44 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # ggplot2 (development version) +* `coord_radial(clip = "on")` clips to the panel area when the graphics device + supports clipping paths (@teunbrand, #5952). +* (internal) Panel clipping responsibility moved from Facet class to Coord + class through new `Coord$draw_panel()` method. +* `theme(strip.clip)` now defaults to `"on"` and is independent of Coord + clipping (@teunbrand, 5952). +* (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand). * Axis labels are now justified across facet panels (@teunbrand, #5820) * Fixed bug in `stat_function()` so x-axis title now produced automatically when no data added. (@phispu, #5647). diff --git a/R/coord-.R b/R/coord-.R index 6736059fbc..57cf351f92 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -208,6 +208,20 @@ Coord <- ggproto("Coord", # used as a fudge for CoordFlip and CoordPolar modify_scales = function(scales_x, scales_y) { invisible() + }, + + draw_panel = function(self, panel, params, theme) { + fg <- self$render_fg(params, theme) + bg <- self$render_bg(params, theme) + if (isTRUE(theme$panel.ontop)) { + panel <- list2(!!!panel, bg, fg) + } else { + panel <- list2(bg, !!!panel, fg) + } + gTree( + children = inject(gList(!!!panel)), + vp = viewport(clip = self$clip) + ) } ) diff --git a/R/coord-radial.R b/R/coord-radial.R index c47d55bb56..2f44e1ae4b 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -409,6 +409,27 @@ CoordRadial <- ggproto("CoordRadial", Coord, ) }, + + draw_panel = function(self, panel, params, theme) { + clip_support <- check_device("clippingPaths", "test", maybe = TRUE) + if (self$clip == "on" && !isFALSE(clip_support)) { + clip_path <- data_frame0( + x = c(Inf, Inf, -Inf, -Inf), + y = c(Inf, -Inf, -Inf, Inf) + ) + clip_path <- coord_munch(self, clip_path, params, is_closed = TRUE) + clip_path <- polygonGrob(clip_path$x, clip_path$y) + # Note that clipping path is applied to panel without coord + # foreground/background (added in parent method). + # These may contain decorations that needn't be clipped + panel <- list(gTree( + children = inject(gList(!!!panel)), + vp = viewport(clip = clip_path) + )) + } + ggproto_parent(Coord, self)$draw_panel(panel, params, theme) + }, + labels = function(self, labels, panel_params) { # `Layout$resolve_label()` doesn't know to look for theta/r/r.sec guides, # so we'll handle title propagation here. diff --git a/R/facet-.R b/R/facet-.R index 359c19a248..780c8bd184 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -153,8 +153,7 @@ Facet <- ggproto("Facet", NULL, table <- self$init_gtable( panels, layout, theme, ranges, params, - aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]), - clip = coord$clip + aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]) ) table <- self$attach_axes(table, layout, ranges, coord, theme, params) @@ -198,7 +197,7 @@ Facet <- ggproto("Facet", NULL, data }, init_gtable = function(panels, layout, theme, ranges, params, - aspect_ratio = NULL, clip = "on") { + aspect_ratio = NULL) { # Initialise matrix of panels dim <- c(max(layout$ROW), max(layout$COL)) @@ -228,7 +227,7 @@ Facet <- ggproto("Facet", NULL, "layout", table, widths = widths, heights = heights, respect = !is.null(aspect_ratio), - clip = clip, z = matrix(1, dim[1], dim[2]) + clip = "off", z = matrix(1, dim[1], dim[2]) ) # Set panel names diff --git a/R/facet-grid-.R b/R/facet-grid-.R index c51df5c138..a0b6e31931 100644 --- a/R/facet-grid-.R +++ b/R/facet-grid-.R @@ -404,13 +404,13 @@ FacetGrid <- ggproto("FacetGrid", Facet, space <- if (!inside_x & table_has_grob(table, "axis-b")) padding table <- seam_table( table, strips$x$bottom, side = "bottom", name = "strip-b", - shift = shift_x, z = 2, clip = "on", spacing = space + shift = shift_x, z = 2, clip = "off", spacing = space ) } else { space <- if (!inside_x & table_has_grob(table, "axis-t")) padding table <- seam_table( table, strips$x$top, side = "top", name = "strip-t", - shift = shift_x, z = 2, clip = "on", spacing = space + shift = shift_x, z = 2, clip = "off", spacing = space ) } @@ -422,13 +422,13 @@ FacetGrid <- ggproto("FacetGrid", Facet, space <- if (!inside_y & table_has_grob(table, "axis-l")) padding table <- seam_table( table, strips$y$left, side = "left", name = "strip-l", - shift = shift_y, z = 2, clip = "on", spacing = space + shift = shift_y, z = 2, clip = "off", spacing = space ) } else { space <- if (!inside_y & table_has_grob(table, "axis-r")) padding table <- seam_table( table, strips$y$right, side = "right", name = "strip-r", - shift = shift_y, z = 2, clip = "on", spacing = space + shift = shift_y, z = 2, clip = "off", spacing = space ) } table diff --git a/R/facet-null.R b/R/facet-null.R index bc95141fde..c66f39fa03 100644 --- a/R/facet-null.R +++ b/R/facet-null.R @@ -63,11 +63,10 @@ FacetNull <- ggproto("FacetNull", Facet, grob_widths <- unit.c(grobWidth(axis_v$left), unit(1, "null"), grobWidth(axis_v$right)) grob_heights <- unit.c(grobHeight(axis_h$top), unit(abs(aspect_ratio), "null"), grobHeight(axis_h$bottom)) grob_names <- c("spacer", "axis-l", "spacer", "axis-t", "panel", "axis-b", "spacer", "axis-r", "spacer") - grob_clip <- c("off", "off", "off", "off", coord$clip, "off", "off", "off", "off") layout <- gtable_matrix("layout", all, widths = grob_widths, heights = grob_heights, - respect = respect, clip = grob_clip, + respect = respect, clip = "off", z = z_matrix ) layout$layout$name <- grob_names diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 93ae19da91..854aacdd80 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -405,7 +405,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, shift <- if (inside) shift[1] else shift[2] size <- unit(size, "cm") - table <- weave(table, mat, shift, size, name = prefix, z = 2, clip = "on") + table <- weave(table, mat, shift, size, name = prefix, z = 2, clip = "off") if (!inside) { axes <- grepl(paste0("axis-", pos), table$layout$name) diff --git a/R/layout.R b/R/layout.R index f6e04f9b9c..1b578111b2 100644 --- a/R/layout.R +++ b/R/layout.R @@ -80,19 +80,8 @@ Layout <- ggproto("Layout", NULL, panels <- lapply(seq_along(panels[[1]]), function(i) { panel <- lapply(panels, `[[`, i) panel <- c(facet_bg[i], panel, facet_fg[i]) - - coord_fg <- self$coord$render_fg(self$panel_params[[i]], theme) - coord_bg <- self$coord$render_bg(self$panel_params[[i]], theme) - if (isTRUE(theme$panel.ontop)) { - panel <- c(panel, list(coord_bg), list(coord_fg)) - } else { - panel <- c(list(coord_bg), panel, list(coord_fg)) - } - - ggname( - paste("panel", i, sep = "-"), - gTree(children = inject(gList(!!!panel))) - ) + panel <- self$coord$draw_panel(panel, self$panel_params[[i]], theme) + ggname(paste("panel", i, sep = "-"), panel) }) plot_table <- self$facet$draw_panels( panels, diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 951f20a01c..9c94e9dce5 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -212,7 +212,7 @@ theme_grey <- function(base_size = 11, base_family = "", panel.ontop = FALSE, strip.background = element_rect(fill = "grey85", colour = NA), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text( colour = "grey10", size = rel(0.8), @@ -511,7 +511,7 @@ theme_void <- function(base_size = 11, base_family = "", legend.box.margin = rel(0), legend.box.spacing = unit(0.2, "cm"), legend.ticks.length = rel(0.2), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text(size = rel(0.8)), strip.switch.pad.grid = rel(0.5), strip.switch.pad.wrap = rel(0.5), @@ -643,7 +643,7 @@ theme_test <- function(base_size = 11, base_family = "", panel.ontop = FALSE, strip.background = element_rect(fill = "grey85", colour = "grey20"), - strip.clip = "inherit", + strip.clip = "on", strip.text = element_text( colour = "grey10", size = rel(0.8), diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg index 66caee5c07..7c936b4768 100644 --- a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg +++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg @@ -108,83 +108,110 @@ - - + + - + + +6 - - + + - - -6 + 1 - - + + - + 8 - -0 - - + + - + + +0 - - + + - + 4 + + + + + + + + + 0 - - + + - + 4 + + + + + + + + + 1 - - + + - + 6 + + + + + + + + + 0 diff --git a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg index c3f247ebe5..7d546bcc7e 100644 --- a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg +++ b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg @@ -93,24 +93,6 @@ - - - - - - - - - - - - - - - - - - @@ -349,15 +331,6 @@ - - - - - - - - - @@ -380,15 +353,6 @@ - - - - - - - - - diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index e9cdcc4813..da49368108 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -158,6 +158,9 @@ test_that("bounding box calculations are sensible", { # Visual tests ------------------------------------------------------------ +#TODO: Once {vdiffr} supports non-rectangular clipping paths, we should add a +# test for `coord_radial(clip = "on")`'s ability to clip to the sector + test_that("polar coordinates draw correctly", { theme <- theme_test() + theme( From c8b802211c1bb39fa038fa5b5c76354daf8f409a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 20 Aug 2024 16:13:17 +0200 Subject: [PATCH 20/31] Improve `pal_qualitative()` (#5954) * precompute checks and lengths * don't use loop to select minimal palette * accept change in error message * add news bullet --- NEWS.md | 1 + R/scale-hue.R | 22 +++++++++++----------- tests/testthat/_snaps/scale-hue.md | 2 +- tests/testthat/test-scale-hue.R | 3 +-- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3408f12b44..4e38488231 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* (internal) improvements to `pal_qualitative()` (@teunbrand, #5013) * `coord_radial(clip = "on")` clips to the panel area when the graphics device supports clipping paths (@teunbrand, #5952). * (internal) Panel clipping responsibility moved from Facet class to Coord diff --git a/R/scale-hue.R b/R/scale-hue.R index db743612ed..414f10864e 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -205,22 +205,22 @@ scale_fill_qualitative <- function(name = waiver(), ..., type = NULL, #' @param type a character vector or a list of character vectors #' @noRd pal_qualitative <- function(type, h, c, l, h.start, direction) { + type_list <- type + if (!is.list(type_list)) { + type_list <- list(type_list) + } + if (!all(vapply(type_list, is.character, logical(1)))) { + stop_input_type(type, "a character vector or list of character vectors") + } + type_lengths <- lengths(type_list) 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 pal_hue() if (max(type_lengths) < 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)] - i <- 1 - while (length(type_list[[i]]) < n) { - i <- i + 1 - } - type_list[[i]][seq_len(n)] + i <- which(type_lengths >= n) + i <- i[which.min(type_lengths[i])] + type_list[[i]] } } diff --git a/tests/testthat/_snaps/scale-hue.md b/tests/testthat/_snaps/scale-hue.md index bccf63c43a..8221bba045 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 list of character vectors, not an integer vector. diff --git a/tests/testthat/test-scale-hue.R b/tests/testthat/test-scale-hue.R index 12568590a8..6f0b0c5234 100644 --- a/tests/testthat/test-scale-hue.R +++ b/tests/testthat/test-scale-hue.R @@ -1,6 +1,5 @@ test_that("scale_hue() checks the type input", { - pal <- pal_qualitative(type = 1:4) - expect_snapshot_error(pal(4)) + expect_snapshot_error(pal_qualitative(type = 1:4)) pal <- pal_qualitative(type = colors()) expect_silent(pal(4)) pal <- pal_qualitative(type = list(colors()[1:10], colors()[11:30])) From e5c389252e82b93b82cc93bce6efcd5e9832d479 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Fri, 23 Aug 2024 11:39:12 +0200 Subject: [PATCH 21/31] Add changes from #4875 (#6049) --- R/geom-path.R | 3 ++- R/geom-text.R | 5 +++-- man/geom_path.Rd | 3 ++- man/geom_text.Rd | 5 +++-- man/labeller.Rd | 2 +- 5 files changed, 11 insertions(+), 7 deletions(-) diff --git a/R/geom-path.R b/R/geom-path.R index 9b737267ca..b63a1a1877 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -36,8 +36,9 @@ #' @examples #' # geom_line() is suitable for time series #' ggplot(economics, aes(date, unemploy)) + geom_line() +#' # separate by colour and use "timeseries" legend key glyph #' ggplot(economics_long, aes(date, value01, colour = variable)) + -#' geom_line() +#' geom_line(key_glyph = "timeseries") #' #' # You can get a timeseries that run vertically by setting the orientation #' ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") diff --git a/R/geom-text.R b/R/geom-text.R index d0f33a12ff..22ae141a1c 100644 --- a/R/geom-text.R +++ b/R/geom-text.R @@ -98,10 +98,11 @@ #' scale_colour_discrete(l = 40) #' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold") #' -#' p + geom_text(aes(size = wt)) +#' # Scale size of text, and change legend key glyph from a to point +#' p + geom_text(aes(size = wt), key_glyph = "point") #' # Scale height of text, rather than sqrt(height) #' p + -#' geom_text(aes(size = wt)) + +#' geom_text(aes(size = wt), key_glyph = "point") + #' scale_radius(range = c(3,6)) #' #' # You can display expressions by setting parse = TRUE. The diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 8c530e4d33..833ee757c6 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -205,8 +205,9 @@ the \code{NA} is removed silently, without warning. \examples{ # geom_line() is suitable for time series ggplot(economics, aes(date, unemploy)) + geom_line() +# separate by colour and use "timeseries" legend key glyph ggplot(economics_long, aes(date, value01, colour = variable)) + - geom_line() + geom_line(key_glyph = "timeseries") # You can get a timeseries that run vertically by setting the orientation ggplot(economics, aes(unemploy, date)) + geom_line(orientation = "y") diff --git a/man/geom_text.Rd b/man/geom_text.Rd index 5f5dabe2d0..f50563730c 100644 --- a/man/geom_text.Rd +++ b/man/geom_text.Rd @@ -249,10 +249,11 @@ p + geom_text(aes(colour = factor(cyl))) + scale_colour_discrete(l = 40) p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold") -p + geom_text(aes(size = wt)) +# Scale size of text, and change legend key glyph from a to point +p + geom_text(aes(size = wt), key_glyph = "point") # Scale height of text, rather than sqrt(height) p + - geom_text(aes(size = wt)) + + geom_text(aes(size = wt), key_glyph = "point") + scale_radius(range = c(3,6)) # You can display expressions by setting parse = TRUE. The diff --git a/man/labeller.Rd b/man/labeller.Rd index 52481179f9..2c863d2aee 100644 --- a/man/labeller.Rd +++ b/man/labeller.Rd @@ -42,7 +42,7 @@ for the argument \code{labeller}. \description{ This function makes it easy to assign different labellers to different factors. The labeller can be a function or it can be a -named character vectors that will serve as a lookup table. +named character vector that will serve as a lookup table. } \details{ In case of functions, if the labeller has class \code{labeller}, it From c9dce8a91a22d895d4318bb180c03021fe89b78b Mon Sep 17 00:00:00 2001 From: "Collin K. Berke, Ph.D." <32435546+collinberke@users.noreply.github.com> Date: Fri, 23 Aug 2024 02:41:50 -0700 Subject: [PATCH 22/31] Fix typos layer and geom_text docs (#6053) --- R/geom-text.R | 2 +- R/layer.R | 2 +- man/borders.Rd | 2 +- man/geom_blank.Rd | 2 +- man/geom_contour.Rd | 2 +- man/geom_errorbarh.Rd | 2 +- man/geom_function.Rd | 2 +- man/geom_jitter.Rd | 2 +- man/geom_linerange.Rd | 2 +- man/geom_map.Rd | 2 +- man/geom_path.Rd | 2 +- man/geom_point.Rd | 2 +- man/geom_polygon.Rd | 2 +- man/geom_ribbon.Rd | 2 +- man/geom_rug.Rd | 2 +- man/geom_segment.Rd | 2 +- man/geom_spoke.Rd | 2 +- man/geom_text.Rd | 4 ++-- man/geom_tile.Rd | 2 +- man/ggsf.Rd | 2 +- man/layer.Rd | 2 +- man/layer_sf.Rd | 2 +- 22 files changed, 23 insertions(+), 23 deletions(-) diff --git a/R/geom-text.R b/R/geom-text.R index 22ae141a1c..a913227e4b 100644 --- a/R/geom-text.R +++ b/R/geom-text.R @@ -49,7 +49,7 @@ #' can be used in various ways, including to prevent overplotting and #' improving the display. The `position` argument accepts the following: #' * The result of calling a position function, such as `position_jitter()`. -#' * A string nameing the position adjustment. To give the position as a +#' * A string naming the position adjustment. To give the position as a #' string, strip the function name of the `position_` prefix. For example, #' to use `position_jitter()`, give the position as `"jitter"`. #' * For more information and other ways to specify the position, see the diff --git a/R/layer.R b/R/layer.R index 7fc53571ef..bcad622d98 100644 --- a/R/layer.R +++ b/R/layer.R @@ -36,7 +36,7 @@ #' [layer geom][layer_geoms] documentation. #' @param stat The statistical transformation to use on the data for this layer. #' When using a `geom_*()` function to construct a layer, the `stat` -#' argument can be used the override the default coupling between geoms and +#' argument can be used to override the default coupling between geoms and #' stats. The `stat` argument accepts the following: #' * A `Stat` ggproto subclass, for example `StatCount`. #' * A string naming the stat. To give the stat as a string, strip the diff --git a/man/borders.Rd b/man/borders.Rd index 2fa16916e9..2f5e9f6841 100644 --- a/man/borders.Rd +++ b/man/borders.Rd @@ -53,7 +53,7 @@ will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{\code{stat}}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_blank.Rd b/man/geom_blank.Rd index 1f02b9cbc6..a8d4a2613d 100644 --- a/man/geom_blank.Rd +++ b/man/geom_blank.Rd @@ -37,7 +37,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_contour.Rd b/man/geom_contour.Rd index 72114072e2..c42aec41c9 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -89,7 +89,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_errorbarh.Rd b/man/geom_errorbarh.Rd index 21a4c79f5c..4e6fb3aae9 100644 --- a/man/geom_errorbarh.Rd +++ b/man/geom_errorbarh.Rd @@ -38,7 +38,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_function.Rd b/man/geom_function.Rd index 451c779003..faf9d8552e 100644 --- a/man/geom_function.Rd +++ b/man/geom_function.Rd @@ -41,7 +41,7 @@ mapping.} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_jitter.Rd b/man/geom_jitter.Rd index 2fa8acf555..03ad3e8490 100644 --- a/man/geom_jitter.Rd +++ b/man/geom_jitter.Rd @@ -40,7 +40,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_linerange.Rd b/man/geom_linerange.Rd index 0d70775f6d..87bc5c8e75 100644 --- a/man/geom_linerange.Rd +++ b/man/geom_linerange.Rd @@ -81,7 +81,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_map.Rd b/man/geom_map.Rd index 6a634702e9..58e83adad4 100644 --- a/man/geom_map.Rd +++ b/man/geom_map.Rd @@ -38,7 +38,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_path.Rd b/man/geom_path.Rd index 833ee757c6..88913a5a7b 100644 --- a/man/geom_path.Rd +++ b/man/geom_path.Rd @@ -70,7 +70,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_point.Rd b/man/geom_point.Rd index 762d4a1f80..56264c0a36 100644 --- a/man/geom_point.Rd +++ b/man/geom_point.Rd @@ -38,7 +38,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_polygon.Rd b/man/geom_polygon.Rd index 22670cbb8b..241490284a 100644 --- a/man/geom_polygon.Rd +++ b/man/geom_polygon.Rd @@ -39,7 +39,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_ribbon.Rd b/man/geom_ribbon.Rd index 2c7e805fc7..d4f5a707e1 100644 --- a/man/geom_ribbon.Rd +++ b/man/geom_ribbon.Rd @@ -66,7 +66,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_rug.Rd b/man/geom_rug.Rd index 6e84a4d985..1cc10e785a 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -41,7 +41,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_segment.Rd b/man/geom_segment.Rd index fc3adbbd8c..392ba20669 100644 --- a/man/geom_segment.Rd +++ b/man/geom_segment.Rd @@ -60,7 +60,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_spoke.Rd b/man/geom_spoke.Rd index 7fe6a9d9ee..ea28f601c1 100644 --- a/man/geom_spoke.Rd +++ b/man/geom_spoke.Rd @@ -39,7 +39,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/geom_text.Rd b/man/geom_text.Rd index f50563730c..91c241ab4b 100644 --- a/man/geom_text.Rd +++ b/man/geom_text.Rd @@ -62,7 +62,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. @@ -79,7 +79,7 @@ can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. -\item A string nameing the position adjustment. To give the position as a +\item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the diff --git a/man/geom_tile.Rd b/man/geom_tile.Rd index 326f36a2f4..34b9bb30bc 100644 --- a/man/geom_tile.Rd +++ b/man/geom_tile.Rd @@ -67,7 +67,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/ggsf.Rd b/man/ggsf.Rd index 3b8ff90bd7..c4ec76bed1 100644 --- a/man/ggsf.Rd +++ b/man/ggsf.Rd @@ -197,7 +197,7 @@ from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/layer.Rd b/man/layer.Rd index b4070fbe2a..e34ee05245 100644 --- a/man/layer.Rd +++ b/man/layer.Rd @@ -35,7 +35,7 @@ give the geom as \code{"point"}. \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. diff --git a/man/layer_sf.Rd b/man/layer_sf.Rd index cda8db1d2e..a10dfa8805 100644 --- a/man/layer_sf.Rd +++ b/man/layer_sf.Rd @@ -33,7 +33,7 @@ give the geom as \code{"point"}. \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. From 6d2ed6de1cd367f79e432b81d7faa8dce411ca0e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 13:14:14 +0200 Subject: [PATCH 23/31] Extra documentation for `ggplot_add()` (#5968) --- R/plot-construction.R | 25 ++++++++++++++++++++++++- man/ggplot_add.Rd | 25 +++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 1 deletion(-) diff --git a/R/plot-construction.R b/R/plot-construction.R index de1306098f..43a3f5b494 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -84,9 +84,32 @@ add_ggplot <- function(p, object, objectname) { #' @param object_name The name of the object to add #' #' @return A modified ggplot object +#' @details +#' Custom methods for `ggplot_add()` are intended to update the `plot` variable +#' using information from a custom `object`. This can become convenient when +#' writing extensions that don't build on the pre-existing grammar like +#' layers, facets, coords and themes. The `ggplot_add()` function is never +#' intended to be used directly, but it is triggered when an object is added +#' to a plot via the `+` operator. Please note that the full `plot` object is +#' exposed at this point, which comes with the responsibility of returning +#' the plot intact. #' #' @keywords internal #' @export +#' @examples +#' # making a new method for the generic +#' # in this example, we apply a text element to the text theme setting +#' ggplot_add.element_text <- function(object, plot, object_name) { +#' plot + theme(text = object) +#' } +#' +#' # we can now use `+` to add our object to a plot +#' ggplot(mpg, aes(displ, cty)) + +#' geom_point() + +#' element_text(colour = "red") +#' +#' # clean-up +#' rm(ggplot_add.element_text) ggplot_add <- function(object, plot, object_name) { UseMethod("ggplot_add") } @@ -152,7 +175,7 @@ ggplot_add.Facet <- function(object, plot, object_name) { #' @export ggplot_add.list <- function(object, plot, object_name) { for (o in object) { - plot <- plot %+% o + plot <- ggplot_add(o, plot, object_name) } plot } diff --git a/man/ggplot_add.Rd b/man/ggplot_add.Rd index 0bd2e2a698..c71d6f863e 100644 --- a/man/ggplot_add.Rd +++ b/man/ggplot_add.Rd @@ -20,4 +20,29 @@ A modified ggplot object This generic allows you to add your own methods for adding custom objects to a ggplot with \link{+.gg}. } +\details{ +Custom methods for \code{ggplot_add()} are intended to update the \code{plot} variable +using information from a custom \code{object}. This can become convenient when +writing extensions that don't build on the pre-existing grammar like +layers, facets, coords and themes. The \code{ggplot_add()} function is never +intended to be used directly, but it is triggered when an object is added +to a plot via the \code{+} operator. Please note that the full \code{plot} object is +exposed at this point, which comes with the responsibility of returning +the plot intact. +} +\examples{ +# making a new method for the generic +# in this example, we apply a text element to the text theme setting +ggplot_add.element_text <- function(object, plot, object_name) { + plot + theme(text = object) +} + +# we can now use `+` to add our object to a plot +ggplot(mpg, aes(displ, cty)) + + geom_point() + + element_text(colour = "red") + +# clean-up +rm(ggplot_add.element_text) +} \keyword{internal} From 5482939bec47e4abe3d449667680aa323ed47b2a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 13:19:44 +0200 Subject: [PATCH 24/31] Layers have names (#5967) * use `%||%` for `na.rm` * simplify special `key_glyph` case * add `name` field to LayerInstance objects * helper for layer names * apply layer names * add tests * add bullet * fallback for direct `layer()` calls --- NEWS.md | 1 + R/layer.R | 21 +++++++-------------- R/plot-construction.R | 19 +++++++++++++++++++ tests/testthat/test-layer.R | 16 ++++++++++++++++ 4 files changed, 43 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4e38488231..fac6706ae8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Layers can have names (@teunbrand, #4066). * (internal) improvements to `pal_qualitative()` (@teunbrand, #5013) * `coord_radial(clip = "on")` clips to the panel area when the graphics device supports clipping paths (@teunbrand, #5952). diff --git a/R/layer.R b/R/layer.R index bcad622d98..59a9dba096 100644 --- a/R/layer.R +++ b/R/layer.R @@ -130,16 +130,7 @@ layer <- function(geom = NULL, stat = NULL, position <- check_subclass(position, "Position", env = parent.frame(), call = call_env) # Special case for na.rm parameter needed by all layers - if (is.null(params$na.rm)) { - params$na.rm <- FALSE - } - - # Special case for key_glyph parameter which is handed in through - # params since all geoms/stats forward ... to params - if (!is.null(params$key_glyph)) { - key_glyph <- params$key_glyph - params$key_glyph <- NULL # remove to avoid warning about unknown parameter - } + params$na.rm <- params$na.rm %||% FALSE # Split up params between aesthetics, geom, and stat params <- rename_aes(params) @@ -147,7 +138,8 @@ layer <- function(geom = NULL, stat = NULL, geom_params <- params[intersect(names(params), geom$parameters(TRUE))] stat_params <- params[intersect(names(params), stat$parameters(TRUE))] - all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics()) + ignore <- c("key_glyph", "name") + all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics(), ignore) # Take care of plain patterns provided as aesthetic pattern <- vapply(aes_params, is_pattern, logical(1)) @@ -181,9 +173,9 @@ layer <- function(geom = NULL, stat = NULL, } # adjust the legend draw key if requested - geom <- set_draw_key(geom, key_glyph) + geom <- set_draw_key(geom, key_glyph %||% params$key_glyph) - fr_call <- layer_class$constructor %||% frame_call(call_env) + fr_call <- layer_class$constructor %||% frame_call(call_env) %||% current_call() ggproto("LayerInstance", layer_class, constructor = fr_call, @@ -196,7 +188,8 @@ layer <- function(geom = NULL, stat = NULL, aes_params = aes_params, position = position, inherit.aes = inherit.aes, - show.legend = show.legend + show.legend = show.legend, + name = params$name ) } diff --git a/R/plot-construction.R b/R/plot-construction.R index 43a3f5b494..14f2badaed 100644 --- a/R/plot-construction.R +++ b/R/plot-construction.R @@ -186,6 +186,25 @@ ggplot_add.by <- function(object, plot, object_name) { #' @export ggplot_add.Layer <- function(object, plot, object_name) { + layers_names <- new_layer_names(object, names(plot$layers)) plot$layers <- append(plot$layers, object) + names(plot$layers) <- layers_names plot } + +new_layer_names <- function(layer, existing) { + new_name <- layer$name + if (is.null(new_name)) { + # Construct a name from the layer's call + new_name <- call_name(layer$constructor) + + if (new_name %in% existing) { + names <- c(existing, new_name) + names <- vec_as_names(names, repair = "unique", quiet = TRUE) + new_name <- names[length(names)] + } + } + + names <- c(existing, new_name) + vec_as_names(names, repair = "check_unique") +} diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index ea7f9c8c60..8be6c8555f 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -138,6 +138,22 @@ test_that("layer warns for constant aesthetics", { expect_snapshot_warning(ggplot_build(p)) }) +test_that("layer names can be resolved", { + + p <- ggplot() + geom_point() + geom_point() + expect_equal(names(p$layers), c("geom_point", "geom_point...2")) + + p <- ggplot() + geom_point(name = "foo") + geom_point(name = "bar") + expect_equal(names(p$layers), c("foo", "bar")) + + l <- geom_point(name = "foobar") + expect_error( + p + l + l, + "names are duplicated" + ) +}) + + # Data extraction --------------------------------------------------------- test_that("AsIs data passes unmodified", { From 332a8ea743d3d1efae819e1b7938afb6b27ffc18 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 13:44:57 +0200 Subject: [PATCH 25/31] `n.breaks` propagate to `sec.axis` (#5973) * capture `n.breaks` parameter upon initialisation * add test * add news bullet --- NEWS.md | 1 + R/axis-secondary.R | 8 +++++++- tests/testthat/test-sec-axis.R | 19 +++++++++++++++++++ 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index fac6706ae8..cd4ed0771d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Secondary axes respect `n.breaks` setting in continuous scales (@teunbrand, #4483). * Layers can have names (@teunbrand, #4066). * (internal) improvements to `pal_qualitative()` (@teunbrand, #5013) * `coord_radial(clip = "on")` clips to the panel area when the graphics device diff --git a/R/axis-secondary.R b/R/axis-secondary.R index e535b1a95a..2999bd79b5 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -188,7 +188,13 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (scale$is_discrete()) { self$breaks <- scale$get_breaks() } else { - self$breaks <- scale$get_transformation()$breaks + breaks <- scale$get_transformation()$breaks + n_breaks <- scale$n.breaks + if (!is.null(n_breaks) && "n" %in% fn_fmls_names(breaks)) { + self$breaks <- function(x) breaks(x, n = n_breaks) + } else { + self$breaks <- breaks + } } } if (is.derived(self$labels)) self$labels <- scale$labels diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index 56a788b469..02846e9f81 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -400,3 +400,22 @@ test_that("discrete scales can have secondary axes", { expect_equal(y$.value, c(1.5, 2.5), ignore_attr = TRUE) expect_equal(y$.label, c("grault", "garply")) }) + +test_that("n.breaks is respected by secondary axes (#4483)", { + + b <- ggplot_build( + ggplot(data.frame(x = c(0, 10)), aes(x, x)) + + scale_y_continuous( + n.breaks = 11, + sec.axis = sec_axis(~.x*100) + ) + ) + + # We get scale breaks via guide data + prim <- get_guide_data(b, "y") + sec <- get_guide_data(b, "y.sec") + + expect_equal(prim$.value, sec$.value) # .value is in primary scale + expect_equal(prim$.label, as.character(seq(0, 10, length.out = 11))) + expect_equal(sec$.label, as.character(seq(0, 1000, length.out = 11))) +}) From 78b3f3ab0fa45b81c9c7f1d27888699dfc55c6a1 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 14:07:14 +0200 Subject: [PATCH 26/31] move `make_summary_fun()` to `setup_params()` (#5971) * move `make_summary_fun()` to `setup_params()` * add news bullet --- NEWS.md | 2 ++ R/stat-summary-bin.R | 16 ++++++++++------ R/stat-summary.R | 16 ++++++++++------ 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/NEWS.md b/NEWS.md index cd4ed0771d..3755e43011 100644 --- a/NEWS.md +++ b/NEWS.md @@ -148,6 +148,8 @@ (@teunbrand, #5938, #4327). * Fixed bug where empty discrete scales weren't recognised as such (@teunbrand, #5945). +* (internal) The summary function of `stat_summary()` and `stat_summary_bin()` + is setup once in total instead of once per group (@teunbrand, #5971) # ggplot2 3.5.1 diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R index e9cd675e09..3a4fea585e 100644 --- a/R/stat-summary-bin.R +++ b/R/stat-summary-bin.R @@ -64,24 +64,28 @@ stat_summary_bin <- function(mapping = NULL, data = NULL, StatSummaryBin <- ggproto("StatSummaryBin", Stat, required_aes = c("x", "y"), - extra_params = c("na.rm", "orientation"), + extra_params = c("na.rm", "orientation", "fun.data", "fun.max", "fun.min", "fun.args"), + setup_params = function(data, params) { - params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) + params$flipped_aes <- has_flipped_aes(data, params) + params$fun <- make_summary_fun( + params$fun.data, params$fun, + params$fun.max, params$fun.min, + params$fun.args %||% list() + ) params }, - compute_group = function(data, scales, fun.data = NULL, fun = NULL, - fun.max = NULL, fun.min = NULL, fun.args = list(), + compute_group = function(data, scales, fun = NULL, bins = 30, binwidth = NULL, breaks = NULL, origin = NULL, right = FALSE, na.rm = FALSE, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) - fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) x <- flipped_names(flipped_aes)$x breaks <- bin2d_breaks(scales[[x]], breaks, origin, binwidth, bins, right = right) data$bin <- cut(data$x, breaks, include.lowest = TRUE, labels = FALSE) - out <- dapply(data, "bin", fun) + out <- dapply(data, "bin", fun %||% function(df) mean_se(df$y)) locs <- bin_loc(breaks, out$bin) out$x <- locs$mid diff --git a/R/stat-summary.R b/R/stat-summary.R index cf2e2ef4c7..6476021fc5 100644 --- a/R/stat-summary.R +++ b/R/stat-summary.R @@ -181,18 +181,22 @@ stat_summary <- function(mapping = NULL, data = NULL, StatSummary <- ggproto("StatSummary", Stat, required_aes = c("x", "y"), - extra_params = c("na.rm", "orientation"), + extra_params = c("na.rm", "orientation", "fun.data", "fun.max", "fun.min", "fun.args"), + setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params) + params$fun <- make_summary_fun( + params$fun.data, params$fun, + params$fun.max, params$fun.min, + params$fun.args %||% list() + ) params }, - compute_panel = function(data, scales, fun.data = NULL, fun = NULL, - fun.max = NULL, fun.min = NULL, fun.args = list(), - na.rm = FALSE, flipped_aes = FALSE) { + compute_panel = function(data, scales, fun = NULL, + na.rm = FALSE, flipped_aes = FALSE) { data <- flip_data(data, flipped_aes) - fun <- make_summary_fun(fun.data, fun, fun.max, fun.min, fun.args) - summarised <- summarise_by_x(data, fun) + summarised <- summarise_by_x(data, fun %||% function(df) mean_se(df$y)) summarised$flipped_aes <- flipped_aes flip_data(summarised, flipped_aes) } From c108758cc8cfa0ee3dafa6b72c88e8b3207312cf Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 14:07:33 +0200 Subject: [PATCH 27/31] Variable panel size (`space`) for `facet_wrap()` (#5956) * add space argument * add test * document * add news bullet * accept new snapshot --- NEWS.md | 2 ++ R/facet-wrap.R | 37 ++++++++++++++++++++++++--- man/facet_wrap.Rd | 8 ++++++ tests/testthat/_snaps/facet-layout.md | 4 +++ tests/testthat/test-facet-layout.R | 21 +++++++++++++++ 5 files changed, 69 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3755e43011..7fbbc1967b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* `facet_wrap()` can have `space = "free_x"` with 1-row layouts and + `space = "free_y"` with 1-column layouts (@teunbrand) * Secondary axes respect `n.breaks` setting in continuous scales (@teunbrand, #4483). * Layers can have names (@teunbrand, #4066). * (internal) improvements to `pal_qualitative()` (@teunbrand, #5013) diff --git a/R/facet-wrap.R b/R/facet-wrap.R index 854aacdd80..8564f319b7 100644 --- a/R/facet-wrap.R +++ b/R/facet-wrap.R @@ -18,6 +18,12 @@ NULL #' @param scales Should scales be fixed (`"fixed"`, the default), #' free (`"free"`), or free in one dimension (`"free_x"`, #' `"free_y"`)? +#' @param space If `"fixed"` (default), all panels have the same size and +#' the number of rows and columns in the layout can be arbitrary. If +#' `"free_x"`, panels have widths proportional to the length of the x-scale, +#' but the layout is constrained to one row. If `"free_y"`, panels have +#' heights proportional to the length of the y-scale, but the layout is +#' constrained to one column. #' @param strip.position By default, the labels are displayed on the top of #' the plot. Using `strip.position` it is possible to place the labels on #' either of the four sides by setting \code{strip.position = c("top", @@ -109,9 +115,9 @@ NULL #' geom_point() + #' facet_wrap(vars(class), dir = "tr") facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", - shrink = TRUE, labeller = "label_value", as.table = TRUE, - switch = deprecated(), drop = TRUE, dir = "h", - strip.position = 'top', axes = "margins", + space = "fixed", shrink = TRUE, labeller = "label_value", + as.table = TRUE, switch = deprecated(), drop = TRUE, + dir = "h", strip.position = 'top', axes = "margins", axis.labels = "all") { scales <- arg_match0(scales %||% "fixed", c("fixed", "free_x", "free_y", "free")) dir <- arg_match0(dir, c("h", "v", "lt", "tl", "lb", "bl", "rt", "tr", "rb", "br")) @@ -128,6 +134,30 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", y = any(scales %in% c("free_y", "free")) ) + # We cannot have free space in both directions + space <- arg_match0(space, c("free_x", "free_y", "fixed")) + space_free <- list(x = space == "free_x", y = space == "free_y") + if (space_free$x) { + if ((nrow %||% 1) != 1 || !is.null(ncol)) { + cli::cli_warn( + "Cannot use {.code space = \"free_x\"} with custom \\ + {.arg nrow} or {.arg ncol}." + ) + } + ncol <- NULL + nrow <- 1L + } + if (space_free$y) { + if ((ncol %||% 1) != 1 || !is.null(nrow)) { + cli::cli_warn( + "Cannot use {.code space= \"free_y\"} with custom \\ + {.arg nrow} or {.arg ncol}." + ) + } + ncol <- 1L + nrow <- NULL + } + # If scales are free, always draw the axes draw_axes <- arg_match0(axes, c("margins", "all_x", "all_y", "all")) draw_axes <- list( @@ -174,6 +204,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", drop = drop, ncol = ncol, nrow = nrow, + space_free = space_free, labeller = labeller, dir = dir, draw_axes = draw_axes, diff --git a/man/facet_wrap.Rd b/man/facet_wrap.Rd index d431f0098a..66716f5c5f 100644 --- a/man/facet_wrap.Rd +++ b/man/facet_wrap.Rd @@ -9,6 +9,7 @@ facet_wrap( nrow = NULL, ncol = NULL, scales = "fixed", + space = "fixed", shrink = TRUE, labeller = "label_value", as.table = TRUE, @@ -35,6 +36,13 @@ or a character vector, \code{c("a", "b")}.} free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"})?} +\item{space}{If \code{"fixed"} (default), all panels have the same size and +the number of rows and columns in the layout can be arbitrary. If +\code{"free_x"}, panels have widths proportional to the length of the x-scale, +but the layout is constrained to one row. If \code{"free_y"}, panels have +heights proportional to the length of the y-scale, but the layout is +constrained to one column.} + \item{shrink}{If \code{TRUE}, will shrink scales to fit output of statistics, not raw data. If \code{FALSE}, will be range of raw data before statistical summary.} diff --git a/tests/testthat/_snaps/facet-layout.md b/tests/testthat/_snaps/facet-layout.md index 142bde22fe..1ab4474443 100644 --- a/tests/testthat/_snaps/facet-layout.md +++ b/tests/testthat/_snaps/facet-layout.md @@ -22,6 +22,10 @@ `nrow` must be a whole number or `NULL`, not the number 1.5. +--- + + Cannot use `space = "free_x"` with custom `nrow` or `ncol`. + --- Need 3 panels, but together `nrow` and `ncol` only provide 1. diff --git a/tests/testthat/test-facet-layout.R b/tests/testthat/test-facet-layout.R index 70a4ed30e8..767abe5c8c 100644 --- a/tests/testthat/test-facet-layout.R +++ b/tests/testthat/test-facet-layout.R @@ -172,6 +172,25 @@ test_that("grid: drop = FALSE preserves unused levels", { expect_equal(as.character(grid_ab$b), as.character(rep(4:1, 4))) }) +test_that("wrap: space = 'free_x/y' sets panel sizes", { + + df <- data.frame(x = 1:3) + p <- ggplot(df, aes(x, x)) + + geom_point() + + scale_x_continuous(limits = c(0, NA), expand = c(0, 0)) + + scale_y_continuous(limits = c(0, NA), expand = c(0, 0)) + + # Test free_x + gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_x", space = "free_x")) + test <- gt$widths[panel_cols(gt)$l] + expect_equal(as.numeric(test), 1:3) + + # Test free_y + gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_y", space = "free_y")) + test <- gt$heights[panel_rows(gt)$t] + expect_equal(as.numeric(test), 1:3) +}) + # Missing behaviour ---------------------------------------------------------- a3 <- data_frame( @@ -207,6 +226,8 @@ test_that("facet_wrap throws errors at bad layout specs", { expect_snapshot_error(facet_wrap(~test, nrow = -1)) expect_snapshot_error(facet_wrap(~test, nrow = 1.5)) + expect_snapshot_warning(facet_wrap(~test, nrow = 2, space = "free_x")) + p <- ggplot(mtcars) + geom_point(aes(mpg, disp)) + facet_wrap(~gear, ncol = 1, nrow = 1) From c38606ffeacfecf54ac32c37c8430d7d9f074fec Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 14:44:06 +0200 Subject: [PATCH 28/31] Function to reset all aesthetics defaults (#5976) * reset functions * document * add test * add news bullet * fix typo --- NAMESPACE | 2 ++ NEWS.md | 2 ++ R/geom-defaults.R | 36 ++++++++++++++++++++++++++++++++++-- man/update_defaults.Rd | 17 ++++++++++++++--- tests/testthat/test-geom-.R | 7 +++++++ 5 files changed, 59 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6a57c5132d..ea62e9b076 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -513,6 +513,8 @@ export(remove_missing) export(render_axes) export(render_strips) export(replace_theme) +export(reset_geom_defaults) +export(reset_stat_defaults) export(reset_theme_settings) export(resolution) export(scale_alpha) diff --git a/NEWS.md b/NEWS.md index 7fbbc1967b..39fab0861b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* New `reset_geom_defaults()` and `reset_stat_defaults()` to restore all geom or + stat default aesthetics at once (@teunbrand, #5975). * `facet_wrap()` can have `space = "free_x"` with 1-row layouts and `space = "free_y"` with 1-column layouts (@teunbrand) * Secondary axes respect `n.breaks` setting in continuous scales (@teunbrand, #4483). diff --git a/R/geom-defaults.R b/R/geom-defaults.R index 8b81eeef94..e4e09ce71c 100644 --- a/R/geom-defaults.R +++ b/R/geom-defaults.R @@ -1,5 +1,7 @@ #' Modify geom/stat aesthetic defaults for future plots #' +#' Functions to update or reset the default aesthetics of geoms and stats. +#' #' @param stat,geom Name of geom/stat to modify (like `"point"` or #' `"bin"`), or a Geom/Stat object (like `GeomPoint` or #' `StatBin`). @@ -17,9 +19,11 @@ #' GeomPoint$default_aes #' ggplot(mtcars, aes(mpg, wt)) + geom_point() #' -#' # reset default +#' # reset single default #' update_geom_defaults("point", NULL) #' +#' # reset all defaults +#' reset_geom_defaults() #' #' # updating a stat's default aesthetic settings #' # example: change stat_bin()'s default y-axis to the density scale @@ -30,9 +34,12 @@ #' geom_histogram() + #' geom_function(fun = dnorm, color = "red") #' -#' # reset default +#' # reset single default #' update_stat_defaults("bin", NULL) #' +#' # reset all defaults +#' reset_stat_defaults() +#' #' @rdname update_defaults update_geom_defaults <- function(geom, new) { update_defaults(geom, "Geom", new, env = parent.frame()) @@ -44,6 +51,14 @@ update_stat_defaults <- function(stat, new) { update_defaults(stat, "Stat", new, env = parent.frame()) } +#' @rdname update_defaults +#' @export +reset_geom_defaults <- function() reset_defaults("geom") + +#' @rdname update_defaults +#' @export +reset_stat_defaults <- function() reset_defaults("stat") + cache_defaults <- new_environment() update_defaults <- function(name, subclass, new, env = parent.frame()) { @@ -73,3 +88,20 @@ update_defaults <- function(name, subclass, new, env = parent.frame()) { } } + +reset_defaults <- function(type) { + # Lookup matching names in cache + prefix <- paste0("^", type, "_") + full_names <- grep(prefix, ls(cache_defaults), value = TRUE) + # Early exit if there is nothing to reset + if (length(full_names) < 1) { + return(invisible()) + } + # Format names without prefix + short_names <- gsub(prefix, "", full_names) + names(short_names) <- full_names + + # Run updates + update <- switch(type, geom = update_geom_defaults, update_stat_defaults) + invisible(lapply(short_names, update, new = NULL)) +} diff --git a/man/update_defaults.Rd b/man/update_defaults.Rd index 8006bf8246..334dffed8e 100644 --- a/man/update_defaults.Rd +++ b/man/update_defaults.Rd @@ -3,11 +3,17 @@ \name{update_geom_defaults} \alias{update_geom_defaults} \alias{update_stat_defaults} +\alias{reset_geom_defaults} +\alias{reset_stat_defaults} \title{Modify geom/stat aesthetic defaults for future plots} \usage{ update_geom_defaults(geom, new) update_stat_defaults(stat, new) + +reset_geom_defaults() + +reset_stat_defaults() } \arguments{ \item{new}{One of the following: @@ -21,7 +27,7 @@ update_stat_defaults(stat, new) \code{StatBin}).} } \description{ -Modify geom/stat aesthetic defaults for future plots +Functions to update or reset the default aesthetics of geoms and stats. } \examples{ @@ -32,9 +38,11 @@ update_geom_defaults("point", aes(color = "red")) GeomPoint$default_aes ggplot(mtcars, aes(mpg, wt)) + geom_point() -# reset default +# reset single default update_geom_defaults("point", NULL) +# reset all defaults +reset_geom_defaults() # updating a stat's default aesthetic settings # example: change stat_bin()'s default y-axis to the density scale @@ -45,8 +53,11 @@ ggplot(data.frame(x = rnorm(1e3)), aes(x)) + geom_histogram() + geom_function(fun = dnorm, color = "red") -# reset default +# reset single default update_stat_defaults("bin", NULL) +# reset all defaults +reset_stat_defaults() + } \keyword{internal} diff --git a/tests/testthat/test-geom-.R b/tests/testthat/test-geom-.R index 61063d5d95..e0a0ca060a 100644 --- a/tests/testthat/test-geom-.R +++ b/tests/testthat/test-geom-.R @@ -20,6 +20,13 @@ test_that("geom defaults can be set and reset", { test <- l$geom$use_defaults(data_frame0()) expect_equal(test$colour, "black") expect_equal(inv$colour, "red") + + inv <- update_geom_defaults("line", list(colour = "blue")) + reset <- reset_geom_defaults() + + expect_equal(reset$geom_line$colour, "blue") + expect_equal(reset$geom_point$colour, GeomPoint$default_aes$colour) + expect_equal(GeomLine$default_aes$colour, inv$colour) }) test_that("updating geom aesthetic defaults preserves class and order", { From 3a7ae74a4c9ba7e93dcfa01bb19091302567eaa2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 14:44:40 +0200 Subject: [PATCH 29/31] `facet_grid(space = "free")` can work with `coord_fixed()` (#5977) * allow coord aspect ratio when space is free * add test * add news bullet --- NEWS.md | 2 ++ R/facet-.R | 20 ++++++++++++-------- tests/testthat/test-facet-layout.R | 17 +++++++++++++++++ 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index 39fab0861b..f6e8221ac0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -154,6 +154,8 @@ (@teunbrand, #5945). * (internal) The summary function of `stat_summary()` and `stat_summary_bin()` is setup once in total instead of once per group (@teunbrand, #5971) +* `facet_grid(space = "free")` can now be combined with `coord_fixed()` + (@teunbrand, #4584). # ggplot2 3.5.1 diff --git a/R/facet-.R b/R/facet-.R index 780c8bd184..a5e6f35101 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -139,18 +139,22 @@ Facet <- ggproto("Facet", NULL, free <- params$free %||% list(x = FALSE, y = FALSE) space <- params$space_free %||% list(x = FALSE, y = FALSE) - if ((free$x || free$y) && !coord$is_free()) { - cli::cli_abort( - "{.fn {snake_class(self)}} can't use free scales with \\ - {.fn {snake_class(coord)}}." - ) - } - aspect_ratio <- theme$aspect.ratio if (!is.null(aspect_ratio) && (space$x || space$y)) { cli::cli_abort("Free scales cannot be mixed with a fixed aspect ratio.") } + if (!coord$is_free()) { + if (space$x && space$y) { + aspect_ratio <- aspect_ratio %||% coord$ratio + } else if (free$x || free$y) { + cli::cli_abort( + "{.fn {snake_class(self)}} can't use free scales with \\ + {.fn {snake_class(coord)}}." + ) + } + } + table <- self$init_gtable( panels, layout, theme, ranges, params, aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]) @@ -219,7 +223,7 @@ Facet <- ggproto("Facet", NULL, if (space$y) { idx <- layout$PANEL[layout$COL == 1] heights <- vapply(idx, function(i) diff(ranges[[i]]$y.range), numeric(1)) - heights <- unit(heights, "null") + heights <- unit(heights * abs(aspect_ratio %||% 1), "null") } # Build gtable diff --git a/tests/testthat/test-facet-layout.R b/tests/testthat/test-facet-layout.R index 767abe5c8c..a008a0c80d 100644 --- a/tests/testthat/test-facet-layout.R +++ b/tests/testthat/test-facet-layout.R @@ -253,6 +253,23 @@ test_that("facet_grid throws errors at bad layout specs", { expect_snapshot_error(ggplotGrob(p)) }) +test_that("facet_grid can respect coord aspect with free scales/space", { + df <- expand.grid(x = letters[1:6], y = LETTERS[1:3]) + p <- ggplot(df, aes(x, y)) + + geom_tile() + + facet_grid( + rows = vars(y == "C"), + cols = vars(x %in% c("e", "f")), + scales = "free", space = "free" + ) + + coord_fixed(3, expand = FALSE) + gt <- ggplotGrob(p) + width <- gt$widths[panel_cols(gt)$l] + height <- gt$heights[panel_rows(gt)$t] + expect_equal(as.numeric(width), c(4, 2)) + expect_equal(as.numeric(height), c(6, 3)) +}) + test_that("facet_wrap and facet_grid throws errors when using reserved words", { mtcars2 <- mtcars mtcars2$PANEL <- mtcars2$cyl From 8ca3bbccc99e44d13e731c90629ba844e20a9d3f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 15:18:36 +0200 Subject: [PATCH 30/31] Update `theme_classic()` (#5981) * update `theme_classic()` * accept snapshots * add news bullet --- NEWS.md | 2 + R/theme-defaults.R | 6 ++- .../_snaps/theme/theme-classic-large.svg | 44 +++++++++---------- tests/testthat/_snaps/theme/theme-classic.svg | 44 +++++++++---------- 4 files changed, 50 insertions(+), 46 deletions(-) diff --git a/NEWS.md b/NEWS.md index f6e8221ac0..ffdd113269 100644 --- a/NEWS.md +++ b/NEWS.md @@ -156,6 +156,8 @@ is setup once in total instead of once per group (@teunbrand, #5971) * `facet_grid(space = "free")` can now be combined with `coord_fixed()` (@teunbrand, #4584). +* `theme_classic()` now has black ticks and text instead of dark gray. In + addition, `theme_classic()`'s axis line end is `"square"` (@teunbrand, #5978). # ggplot2 3.5.1 diff --git a/R/theme-defaults.R b/R/theme-defaults.R index 9c94e9dce5..522c978c68 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -460,10 +460,12 @@ theme_classic <- function(base_size = 11, base_family = "", panel.grid.minor = element_blank(), # show axes - axis.line = element_line(colour = "black", linewidth = rel(1)), + axis.text = element_text(size = rel(0.8)), + axis.line = element_line(lineend = "square"), + axis.ticks = element_line(), # simple, black and white strips - strip.background = element_rect(fill = "white", colour = "black", linewidth = rel(2)), + strip.background = element_rect(linewidth = rel(2)), # NB: size is 1 but clipped, it looks like the 0.5 of the axes complete = TRUE diff --git a/tests/testthat/_snaps/theme/theme-classic-large.svg b/tests/testthat/_snaps/theme/theme-classic-large.svg index 96767cc14f..8a4643dba1 100644 --- a/tests/testthat/_snaps/theme/theme-classic-large.svg +++ b/tests/testthat/_snaps/theme/theme-classic-large.svg @@ -43,28 +43,28 @@ 1 - - - - - - -1.0 -1.5 -2.0 -2.5 -3.0 - -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 + +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + x y diff --git a/tests/testthat/_snaps/theme/theme-classic.svg b/tests/testthat/_snaps/theme/theme-classic.svg index 8588be9819..45ef7ef076 100644 --- a/tests/testthat/_snaps/theme/theme-classic.svg +++ b/tests/testthat/_snaps/theme/theme-classic.svg @@ -43,28 +43,28 @@ 1 - - - - - - -1.0 -1.5 -2.0 -2.5 -3.0 - -1.0 -1.5 -2.0 -2.5 -3.0 - - - - - + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 + +1.0 +1.5 +2.0 +2.5 +3.0 + + + + + x y From bcb87fc120becf836f130fc6c84edca577b11cfd Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 26 Aug 2024 15:18:51 +0200 Subject: [PATCH 31/31] Move {mgcv} to suggests (#5987) * move all method setup to `setup_params()` * fallback to `method = "lm"` in absence of {mgcv} * adjust tests * move {mgcv} from Imports to Suggests * add news bullet * Revert "fallback to `method = "lm"` in absence of {mgcv}" This reverts commit 5824b1df9e300d246e8adeae37a2d462770f199f. * homebrew an install prompt * change fallback * fix `gam_method()` in absence of mgcv * tweak message --- DESCRIPTION | 2 +- NEWS.md | 1 + R/stat-smooth.R | 66 +++++++++++++++++++------------ R/utilities.R | 29 ++++++++++++++ tests/testthat/test-geom-smooth.R | 14 +++++++ 5 files changed, 86 insertions(+), 26 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d97ce7e689..6a14039f20 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,6 @@ Imports: isoband, lifecycle (> 1.0.1), MASS, - mgcv, rlang (>= 1.1.0), scales (>= 1.3.0), stats, @@ -55,6 +54,7 @@ Suggests: knitr, mapproj, maps, + mgcv, multcomp, munsell, nlme, diff --git a/NEWS.md b/NEWS.md index ffdd113269..6a66ca97d4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Moved {mgcv} from Imports to Suggests (@teunbrand, #5986) * New `reset_geom_defaults()` and `reset_stat_defaults()` to restore all geom or stat default aesthetics at once (@teunbrand, #5975). * `facet_wrap()` can have `space = "free_x"` with 1-row layouts and diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 9c72d3570c..147bd06e41 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -95,36 +95,63 @@ StatSmooth <- ggproto("StatSmooth", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) msg <- character() - if (is.null(params$method) || identical(params$method, "auto")) { + method <- params$method + if (is.null(method) || identical(method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for # larger. Based on size of the _largest_ group to avoid bad memory # behaviour of loess max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE))) if (max_group < 1000) { - params$method <- "loess" + method <- "loess" } else { - params$method <- "gam" + method <- "gam" } - msg <- c(msg, paste0("method = '", params$method, "'")) + msg <- c(msg, paste0("method = '", method, "'")) + } + + if (identical(method, "gam") && + !prompt_install("mgcv", "for using {.code method = \"gam\"}")) { + cli::cli_inform(c( + "The {.arg method} was set to {.val gam}, but {.pkg mgcv} is not installed.", + "!" = "Falling back to {.code method = \"lm\"}.", + i = "Install {.pkg mgcv} or change the {.arg method} argument to \\ + resolve this issue." + )) + method <- "lm" } if (is.null(params$formula)) { - if (identical(params$method, "gam")) { + if (identical(method, "gam")) { params$formula <- y ~ s(x, bs = "cs") } else { params$formula <- y ~ x } msg <- c(msg, paste0("formula = '", deparse(params$formula), "'")) } - if (identical(params$method, "gam")) { - params$method <- gam_method() + + # Special case span because it's the most commonly used model argument + if (identical(method, "loess")) { + params$method.args$span <- params$span %||% 0.75 + } + + if (is.character(method)) { + if (identical(method, "gam")) { + method <- gam_method() + } else { + method <- match.fun(method) + } + } + # If gam and gam's method is not specified by the user then use REML + if (identical(method, gam_method())) { + params$method.args$method <- params$method.args$method %||% "REML" } if (length(msg) > 0) { cli::cli_inform("{.fn geom_smooth} using {msg}") } + params$method <- method params }, @@ -159,23 +186,6 @@ StatSmooth <- ggproto("StatSmooth", Stat, } } - # Special case span because it's the most commonly used model argument - if (identical(method, "loess")) { - method.args$span <- span - } - - if (is.character(method)) { - if (identical(method, "gam")) { - method <- gam_method() - } else { - method <- match.fun(method) - } - } - # If gam and gam's method is not specified by the user then use REML - if (identical(method, gam_method()) && is.null(method.args$method)) { - method.args$method <- "REML" - } - prediction <- try_fetch( { model <- inject(method( @@ -205,4 +215,10 @@ StatSmooth <- ggproto("StatSmooth", Stat, ) # This function exists to silence an undeclared import warning -gam_method <- function() mgcv::gam +gam_method <- function() { + if (is_installed("mgcv")) { + mgcv::gam + } else { + NA + } +} diff --git a/R/utilities.R b/R/utilities.R index a3357e6119..0bddb4b4c6 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -846,3 +846,32 @@ as_unordered_factor <- function(x) { class(x) <- setdiff(class(x), "ordered") x } + +# TODO: Replace me if rlang/#1730 gets implemented +# Similar to `rlang::check_installed()` but returns boolean and misses +# features such as versions, comparisons and using {pak}. +prompt_install <- function(pkg, reason = NULL) { + if (length(pkg) < 1 || is_installed(pkg)) { + return(TRUE) + } + if (!interactive()) { + return(FALSE) + } + + pkg <- pkg[!vapply(pkg, is_installed, logical(1))] + + message <- "The {.pkg {pkg}} package{?s} {?is/are} required" + if (is.null(reason)) { + message <- paste0(message, ".") + } else { + message <- paste0(message, " ", reason) + } + question <- "Would you like to install {cli::qty(pkg)}{?it/them}?" + + cli::cli_bullets(c("!" = message, "i" = question)) + if (utils::menu(c("Yes", "No")) != 1) { + return(FALSE) + } + utils::install.packages(pkg) + is_installed(pkg) +} diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index 5f8282c176..42c82108c7 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -57,6 +57,8 @@ test_that("default smoothing methods for small and large data sets work", { y = x^2 + 0.5 * rnorm(1001) ) + skip_if_not_installed("mgcv") + m <- mgcv::gam(y ~ s(x, bs = "cs"), data = df, method = "REML") range <- range(df$x, na.rm = TRUE) xseq <- seq(range[1], range[2], length.out = 80) @@ -96,6 +98,18 @@ test_that("geom_smooth() works when one group fails", { expect_gte(nrow(ld), 2) }) +test_that("a fallback message is thrown when `method = 'gam'` and {mgcv} is absent", { + p <- ggplot(mpg, aes(displ, hwy)) + + geom_smooth(method = "gam", formula = y ~ x) + + with_mocked_bindings( + expect_message( + ggplot_build(p), regexp = "Falling back to `method = \"lm\"`" + ), + is_installed = function(...) FALSE + ) +}) + # Visual tests ------------------------------------------------------------ test_that("geom_smooth() works with alternative stats", {