Merge branch 'main' into theme_geom_defaults

Author: teunbrand

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: 

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)

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
 

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

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))
+}

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)

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)

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(