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 1/7] 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 2/7] `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 3/7] 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 4/7] 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", {
From 8bb9641ab6e6aa9b1e12bea311599967cde6afe2 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Aug 2024 16:07:03 +0200
Subject: [PATCH 5/7] Move {tibble} to suggests (#5990)
* don't use `tibble()` in code
* remove `tibble()` from examples/tests
* redocument
* add news bullet
---
DESCRIPTION | 2 +-
NAMESPACE | 1 -
NEWS.md | 1 +
R/facet-.R | 2 +-
R/position-stack.R | 12 ++++-----
R/summarise-plot.R | 4 +--
R/utilities.R | 4 ---
man/position_stack.Rd | 12 ++++-----
tests/testthat/test-geom-quantile.R | 2 +-
tests/testthat/test-geom-tile.R | 9 +++----
tests/testthat/test-scale-discrete.R | 7 +++--
tests/testthat/test-sec-axis.R | 2 +-
tests/testthat/test-stat-align.R | 39 +++++++++-------------------
13 files changed, 36 insertions(+), 61 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 6a14039f20..b4cd9ec950 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -42,7 +42,6 @@ Imports:
rlang (>= 1.1.0),
scales (>= 1.3.0),
stats,
- tibble,
vctrs (>= 0.6.0),
withr (>= 2.5.0)
Suggests:
@@ -67,6 +66,7 @@ Suggests:
sf (>= 0.7-3),
svglite (>= 2.1.2),
testthat (>= 3.1.5),
+ tibble,
vdiffr (>= 1.0.6),
xml2
Enhances:
diff --git a/NAMESPACE b/NAMESPACE
index ea62e9b076..197845db89 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -735,7 +735,6 @@ importFrom(grid,unit)
importFrom(lifecycle,deprecated)
importFrom(scales,alpha)
importFrom(stats,setNames)
-importFrom(tibble,tibble)
importFrom(utils,.DollarNames)
importFrom(utils,head)
importFrom(utils,tail)
diff --git a/NEWS.md b/NEWS.md
index 6a66ca97d4..b4636c5166 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -159,6 +159,7 @@
(@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).
+* {tibble} is now suggested instead of imported (@teunbrand, #5986)
# ggplot2 3.5.1
diff --git a/R/facet-.R b/R/facet-.R
index a5e6f35101..2e349f6f97 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -564,7 +564,7 @@ is_facets <- function(x) {
# but that seems like a reasonable tradeoff.
eval_facets <- function(facets, data, possible_columns = NULL) {
vars <- compact(lapply(facets, eval_facet, data, possible_columns = possible_columns))
- data_frame0(tibble::as_tibble(vars))
+ data_frame0(!!!vars)
}
eval_facet <- function(facet, data, possible_columns = NULL) {
# Treat the case when `facet` is a quosure of a symbol specifically
diff --git a/R/position-stack.R b/R/position-stack.R
index 2da5c91ef6..6d77269a1f 100644
--- a/R/position-stack.R
+++ b/R/position-stack.R
@@ -116,14 +116,12 @@
#'
#' # Negative values -----------------------------------------------------------
#'
-#' df <- tibble::tribble(
-#' ~x, ~y, ~grp,
-#' "a", 1, "x",
-#' "a", 2, "y",
-#' "b", 1, "x",
-#' "b", 3, "y",
-#' "b", -1, "y"
+#' df <- data.frame(
+#' x = rep(c("a", "b"), 2:3),
+#' y = c(1, 2, 1, 3, -1),
+#' grp = c("x", "y", "x", "y", "y")
#' )
+#'
#' ggplot(data = df, aes(x, y, group = grp)) +
#' geom_col(aes(fill = grp), position = position_stack(reverse = TRUE)) +
#' geom_hline(yintercept = 0)
diff --git a/R/summarise-plot.R b/R/summarise-plot.R
index bdb7cc7af4..9ab046cb8c 100644
--- a/R/summarise-plot.R
+++ b/R/summarise-plot.R
@@ -66,7 +66,7 @@ summarise_layout <- function(p) {
l <- p$layout
layout <- l$layout
- layout <- tibble(
+ layout <- data_frame0(
panel = l$layout$PANEL,
row = l$layout$ROW,
col = l$layout$COL
@@ -134,7 +134,7 @@ summarise_layers <- function(p) {
# This currently only returns the mappings, but in the future, other
# information could be added.
- tibble(
+ data_frame0(
mapping = layer_mappings
)
}
diff --git a/R/utilities.R b/R/utilities.R
index 0bddb4b4c6..6a7ca5921d 100644
--- a/R/utilities.R
+++ b/R/utilities.R
@@ -371,10 +371,6 @@ seq_asc <- function(to, from) {
}
}
-# Needed to trigger package loading
-#' @importFrom tibble tibble
-NULL
-
# Wrapping vctrs data_frame constructor with no name repair
data_frame0 <- function(...) data_frame(..., .name_repair = "minimal")
diff --git a/man/position_stack.Rd b/man/position_stack.Rd
index 024bfd80a4..646ab3c515 100644
--- a/man/position_stack.Rd
+++ b/man/position_stack.Rd
@@ -126,14 +126,12 @@ ggplot(series, aes(time, value, group = type)) +
# Negative values -----------------------------------------------------------
-df <- tibble::tribble(
- ~x, ~y, ~grp,
- "a", 1, "x",
- "a", 2, "y",
- "b", 1, "x",
- "b", 3, "y",
- "b", -1, "y"
+df <- data.frame(
+ x = rep(c("a", "b"), 2:3),
+ y = c(1, 2, 1, 3, -1),
+ grp = c("x", "y", "x", "y", "y")
)
+
ggplot(data = df, aes(x, y, group = grp)) +
geom_col(aes(fill = grp), position = position_stack(reverse = TRUE)) +
geom_hline(yintercept = 0)
diff --git a/tests/testthat/test-geom-quantile.R b/tests/testthat/test-geom-quantile.R
index 742e2850ed..7b6feecb9b 100644
--- a/tests/testthat/test-geom-quantile.R
+++ b/tests/testthat/test-geom-quantile.R
@@ -8,7 +8,7 @@ test_that("geom_quantile matches quantile regression", {
set.seed(6531)
x <- rnorm(10)
- df <- tibble::tibble(
+ df <- data_frame0(
x = x,
y = x^2 + 0.5 * rnorm(10)
)
diff --git a/tests/testthat/test-geom-tile.R b/tests/testthat/test-geom-tile.R
index 581963a4b2..9034e3c9f7 100644
--- a/tests/testthat/test-geom-tile.R
+++ b/tests/testthat/test-geom-tile.R
@@ -17,11 +17,10 @@ test_that("accepts width and height aesthetics", {
geom_tile(fill = NA, colour = "black", linewidth = 1)
out <- get_layer_data(p)
- boundary <- as.data.frame(tibble::tribble(
- ~xmin, ~xmax, ~ymin, ~ymax,
- -1, 1, -1, 1,
- -2, 2, -2, 2
- ))
+ boundary <- data_frame0(
+ xmin = c(-1, -2), xmax = c(1, 2),
+ ymin = c(-1, -2), ymax = c(1, 2)
+ )
expect_equal(out[c("xmin", "xmax", "ymin", "ymax")], boundary)
})
diff --git a/tests/testthat/test-scale-discrete.R b/tests/testthat/test-scale-discrete.R
index 084511571f..9e8eeaf717 100644
--- a/tests/testthat/test-scale-discrete.R
+++ b/tests/testthat/test-scale-discrete.R
@@ -1,10 +1,9 @@
# Missing values ----------------------------------------------------------
-df <- tibble::tibble(
+df <- data_frame0(
x1 = c("a", "b", NA),
- x2 = factor(x1),
- x3 = addNA(x2),
-
+ x2 = factor(c("a", "b", NA)),
+ x3 = factor(c("a", "b", NA), levels = c("a", "b", NA), exclude = NULL),
y = 1:3
)
diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R
index 02846e9f81..7530c4a70c 100644
--- a/tests/testthat/test-sec-axis.R
+++ b/tests/testthat/test-sec-axis.R
@@ -171,7 +171,7 @@ test_that("sec axis works with tidy eval", {
g
}
- t <- tibble(x = letters, y = seq(10, 260, 10), z = 1:26)
+ t <- data_frame0(x = letters, y = seq(10, 260, 10), z = 1:26)
p <- f(t, x, y, z)
diff --git a/tests/testthat/test-stat-align.R b/tests/testthat/test-stat-align.R
index 4c418037b3..457992e747 100644
--- a/tests/testthat/test-stat-align.R
+++ b/tests/testthat/test-stat-align.R
@@ -1,44 +1,29 @@
test_that("standard alignment works", {
- df <- tibble::tribble(
- ~g, ~x, ~y,
- "a", 1, 2,
- "a", 3, 5,
- "a", 5, 1,
- "b", 2, 3,
- "b", 4, 6,
- "b", 6, 7
+ df <- data_frame0(
+ g = rep(c("a", "b"), each = 3L),
+ x = c(1, 3, 5, 2, 4, 6),
+ y = c(2, 5, 1, 3, 6, 7)
)
p <- ggplot(df, aes(x, y, fill = g)) + geom_area(color = "black")
expect_doppelganger("align two areas", p)
})
test_that("alignment with cliffs works", {
- df <- tibble::tribble(
- ~g, ~x, ~y,
- "a", 1, 2,
- "a", 3, 5,
- "a", 5, 1,
- "b", 2, 3,
- "b", 4, 3,
- "b", 4, 6,
- "b", 6, 7
+ df <- data_frame0(
+ g = rep(c("a", "b"), 3:4),
+ x = c(1, 3, 5, 2, 4, 4, 6),
+ y = c(2, 5, 1, 3, 3, 6, 7)
)
-
p <- ggplot(df, aes(x, y, fill = g)) + geom_area(color = "black")
expect_doppelganger("align two areas with cliff", p)
})
test_that("alignment with negative and positive values works", {
- df <- tibble::tribble(
- ~g, ~x, ~y,
- "a", 1, 1,
- "a", 2, 4,
- "a", 3, -4,
- "a", 8, 0,
- "b", 2, 4,
- "b", 6, -4
+ df <- data_frame0(
+ g = rep(c("a", "b"), c(4L, 2L)),
+ x = c(1, 2, 3, 8, 2, 6),
+ y = c(1, 4, -4, 0, 4, -4)
)
-
p <- ggplot(df, aes(x, y, fill = g)) + geom_area(color = "black")
expect_doppelganger("align two areas with pos/neg y", p)
})
From e69687a407addd2c29510153de52a128bde4701e Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Aug 2024 16:10:19 +0200
Subject: [PATCH 6/7] Ignore empty non-mapped aesthetics (#6011)
* drop empty aesthetics with warning
* add test
* add news bullet
---
NEWS.md | 2 ++
R/layer.R | 9 +++++++++
tests/testthat/test-layer.R | 7 +++++++
3 files changed, 18 insertions(+)
diff --git a/NEWS.md b/NEWS.md
index b4636c5166..4cab4f4c79 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
# ggplot2 (development version)
+* Passing empty unmapped aesthetics to layers raises a warning instead of
+ throwing an error (@teunbrand, #6009).
* 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).
diff --git a/R/layer.R b/R/layer.R
index 59a9dba096..eba8666de4 100644
--- a/R/layer.R
+++ b/R/layer.R
@@ -146,6 +146,15 @@ layer <- function(geom = NULL, stat = NULL,
if (any(pattern)) {
aes_params[pattern] <- lapply(aes_params[pattern], list)
}
+ # Drop empty aesthetics
+ empty_aes <- names(aes_params)[lengths(aes_params) == 0]
+ if (length(empty_aes) > 0) {
+ cli::cli_warn(
+ "Ignoring empty aesthetic{?s}: {.arg {empty_aes}}.",
+ call = call_env
+ )
+ aes_params <- aes_params[setdiff(names(aes_params), empty_aes)]
+ }
# Warn about extra params and aesthetics
extra_param <- setdiff(names(params), all)
diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R
index 8be6c8555f..51f0cd9eee 100644
--- a/tests/testthat/test-layer.R
+++ b/tests/testthat/test-layer.R
@@ -25,6 +25,13 @@ test_that("unknown aesthetics create warning", {
expect_warning(geom_point(aes(blah = "red")), "unknown aesthetics")
})
+test_that("empty aesthetics create warning", {
+ expect_warning(
+ geom_point(fill = NULL, shape = character()),
+ "Ignoring empty aesthetics"
+ )
+})
+
test_that("invalid aesthetics throws errors", {
# We want to test error and ignore the scale search message
suppressMessages({
From 5971ff46bc5dfeb1114a5c1e2229bd0a3b897041 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Aug 2024 16:11:47 +0200
Subject: [PATCH 7/7] chore: merge isoband/isolines functions (#6021)
* merge isoband/isolines functions
* Update R/stat-contour.R
Co-authored-by: Thomas Lin Pedersen
---------
Co-authored-by: Thomas Lin Pedersen
---
R/stat-contour.R | 53 +++++++++++-------------------------------------
1 file changed, 12 insertions(+), 41 deletions(-)
diff --git a/R/stat-contour.R b/R/stat-contour.R
index 882879430d..e0590f2ec9 100644
--- a/R/stat-contour.R
+++ b/R/stat-contour.R
@@ -108,7 +108,7 @@ StatContour <- ggproto("StatContour", Stat,
breaks <- contour_breaks(z.range, bins, binwidth, breaks)
isolines <- withr::with_options(list(OutDec = "."), xyz_to_isolines(data, breaks))
- path_df <- iso_to_path(isolines, data$group[1])
+ path_df <- iso_to_geom(isolines, data$group[1], geom = "path")
path_df$level <- as.numeric(path_df$level)
path_df$nlevel <- rescale_max(path_df$level)
@@ -142,7 +142,7 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,
isobands <- withr::with_options(list(OutDec = "."), xyz_to_isobands(data, breaks))
names(isobands) <- pretty_isoband_levels(names(isobands))
- path_df <- iso_to_polygon(isobands, data$group[1])
+ path_df <- iso_to_geom(isobands, data$group[1], geom = "polygon")
path_df$level <- ordered(path_df$level, levels = names(isobands))
path_df$level_low <- breaks[as.numeric(path_df$level)]
@@ -259,51 +259,17 @@ isoband_z_matrix <- function(data) {
raster
}
-#' Convert the output of isolines functions
-#'
-#' @param iso the output of [isoband::isolines()]
-#' @param group the name of the group
-#'
-#' @return A data frame that can be passed to [geom_path()].
-#' @noRd
-#'
-iso_to_path <- function(iso, group = 1) {
- lengths <- vapply(iso, function(x) length(x$x), integer(1))
-
- if (all(lengths == 0)) {
- cli::cli_warn("{.fn stat_contour}: Zero contours were generated")
- return(data_frame0())
- }
-
- levels <- names(iso)
- xs <- unlist(lapply(iso, "[[", "x"), use.names = FALSE)
- ys <- unlist(lapply(iso, "[[", "y"), use.names = FALSE)
- ids <- unlist(lapply(iso, "[[", "id"), use.names = FALSE)
- item_id <- rep(seq_along(iso), lengths)
-
- # Add leading zeros so that groups can be properly sorted
- groups <- paste(group, sprintf("%03d", item_id), sprintf("%03d", ids), sep = "-")
- groups <- factor(groups)
-
- data_frame0(
- level = rep(levels, lengths),
- x = xs,
- y = ys,
- piece = as.integer(groups),
- group = groups,
- .size = length(xs)
- )
-}
-
#' Convert the output of isoband functions
#'
-#' @param iso the output of [isoband::isobands()]
+#' @param iso the output of [isoband::isobands()] or [isoband::isolines()]
#' @param group the name of the group
+#' @param geom The type of geometry to return. Either `"path"` or `"polygon"`
+#' for isolines and isobands respectively.
#'
-#' @return A data frame that can be passed to [geom_polygon()].
+#' @return A data frame that can be passed to [geom_polygon()] or [geom_path()].
#' @noRd
#'
-iso_to_polygon <- function(iso, group = 1) {
+iso_to_geom <- function(iso, group = 1, geom = "path") {
lengths <- vapply(iso, function(x) length(x$x), integer(1))
if (all(lengths == 0)) {
@@ -319,6 +285,11 @@ iso_to_polygon <- function(iso, group = 1) {
# Add leading zeros so that groups can be properly sorted
groups <- paste(group, sprintf("%03d", item_id), sep = "-")
+ if (geom == "path") {
+ groups <- paste(groups, sprintf("%03d", ids), sep = "-")
+ ids <- NULL
+ }
+
groups <- factor(groups)
data_frame0(