diff --git a/DESCRIPTION b/DESCRIPTION
index d97ce7e689..b4cd9ec950 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -39,11 +39,9 @@ Imports:
isoband,
lifecycle (> 1.0.1),
MASS,
- mgcv,
rlang (>= 1.1.0),
scales (>= 1.3.0),
stats,
- tibble,
vctrs (>= 0.6.0),
withr (>= 2.5.0)
Suggests:
@@ -55,6 +53,7 @@ Suggests:
knitr,
mapproj,
maps,
+ mgcv,
multcomp,
munsell,
nlme,
@@ -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 62adb9cb44..f0ccf3bec1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -516,6 +516,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)
@@ -736,7 +738,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 37e646f710..8c5ca3c555 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,6 +6,11 @@
* The `element_geom()` function can be used to populate that argument.
* The `from_theme()` function allows access to the theme default fields from
inside the `aes()` function.
+* 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).
* `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).
@@ -158,6 +163,11 @@
(@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).
+* `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 780c8bd184..2e349f6f97 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
@@ -560,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/geom-defaults.R b/R/geom-defaults.R
index 9bf1689a1e..65974f841a 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`).
@@ -20,9 +22,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
@@ -33,9 +37,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())
@@ -98,6 +105,13 @@ get_geom_defaults <- function(geom, theme = theme_get()) {
stop_input_type(geom, as_cli("a layer function, string or {.cls Geom} object"))
}
+#' @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()
@@ -128,3 +142,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/R/layer.R b/R/layer.R
index 17fc5b79be..8acb438c9e 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/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/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(
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/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/theme-defaults.R b/R/theme-defaults.R
index 5a33920949..77b36e243e 100644
--- a/R/theme-defaults.R
+++ b/R/theme-defaults.R
@@ -468,10 +468,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/R/utilities.R b/R/utilities.R
index 0b8af64fe5..2585de5acc 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")
@@ -864,3 +860,32 @@ on_load({
col_mix <- scales::col_mix
}
})
+
+# 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/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/man/update_defaults.Rd b/man/update_defaults.Rd
index 3aaed3f5ac..777182e24f 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.
}
\note{
Please note that geom defaults can be set \emph{en masse} via the \code{theme(geom)}
@@ -36,9 +42,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
@@ -49,8 +57,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/_snaps/theme/theme-classic-large.svg b/tests/testthat/_snaps/theme/theme-classic-large.svg
index 2386cca4dd..7105d5474b 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
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
diff --git a/tests/testthat/test-geom-.R b/tests/testthat/test-geom-.R
index e6f952ec14..6766178f22 100644
--- a/tests/testthat/test-geom-.R
+++ b/tests/testthat/test-geom-.R
@@ -36,6 +36,13 @@ test_that("geom defaults can be set and reset", {
test <- get_geom_defaults(l)
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", {
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-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", {
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-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({
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)
})