Polishes triggered by revdep failures (#6506)

teunbrand · thomasp85 · web-flow · commit 0f7d790458c9 · 2025-07-02T13:25:54.000+02:00
* don't extract <element_blank>@hjust * ensure `if` switch is scalar * contingency where `merge_element(..., e2 = <S3_element>)` * cast a wider net for function matching * Fix NOTE: no visible binding for global variable 'properties' * stabilise missingness detection for 2D structures * avoid recursion issue when `theme` is missing * avoid renaming argument for S3 method consistency purposes * demote warning to message * stop complaints about 0-length labels, which is commonly used in label supression * allow merging <S3> + <S3> * fix #6521 * fix #6513 * avoid rare error when using GeomSf based extensions * `label.size` should be soft-deprecated first * put `convert` into `local()` too * restore accent colour for `geom_contour()` * new revdepcheck * don't prepend `""` as class * mark the binning change as a breaking change * fix #6531 * fix #6529 * no longer soft-deprecated * attempt to tone down spurious warnings * fallback for translating `geom_errorbarh(height)` * alias to prevent breaking linking docs * avoid `rel(0)` margins, fix #6536 * last attempt at removing rownames * use logical NA for casting purposes --------- Co-authored-by: Thomas Lin Pedersen <thomasp85@gmail.com>
diff --git a/NEWS.md b/NEWS.md
@@ -25,6 +25,9 @@
   rather than in the layer method of `update_ggplot()` 
   (previously `ggplot_add.Layer()`). This may affect code that accessed the 
   `plot$labels` property (@teunbrand, #5894).
+* In binning stats, the default `boundary` is now chosen to better adhere to
+  the `nbin` argument. This may affect plots that use default binning
+  (@teunbrand, #5882, #5036)
 
 ### Lifecycle changes
 
@@ -218,8 +221,6 @@
   aesthetics (@teunbrand, #2800, #3142, #5740, #3722).
 * All binning stats now use the `boundary`/`center` parametrisation rather
   than `origin`, following in `stat_bin()`'s footsteps (@teunbrand).
-* In `stat_bin()`, the default `boundary` is now chosen to better adhere to
-  the `nbin` argument (@teunbrand, #5882, #5036)
 * Reintroduced `drop` argument to `stat_bin()` (@teunbrand, #3449)
 * `stat_bin()` now accepts functions for argument `breaks` (@aijordan, #4561)
 * `after_stat()` and `after_scale()` throw warnings when the computed aesthetics
diff --git a/R/aes.R b/R/aes.R
@@ -261,7 +261,7 @@ is_position_aes <- function(vars) {
 #'
 #' @section Life cycle:
 #'
-#' All these functions are soft-deprecated. Please use tidy evaluation idioms
+#' All these functions are deprecated. Please use tidy evaluation idioms
 #' instead. Regarding `aes_string()`, you can replace it with `.data` pronoun.
 #' For example, the following code can achieve the same mapping as
 #' `aes_string(x_var, y_var)`.
diff --git a/R/compat-plyr.R b/R/compat-plyr.R
@@ -19,7 +19,17 @@ unrowname <- function(x) {
   } else if (is.matrix(x)) {
     dimnames(x)[1] <- list(NULL)
   } else {
-    cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.")
+    try_fetch(
+      {
+        rownames(x) <- NULL
+      },
+      error = function(cnd) {
+        cli::cli_abort(
+          "Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.",
+          parent = cnd
+        )
+      }
+    )
   }
   x
 }
diff --git a/R/coord-radial.R b/R/coord-radial.R
@@ -136,7 +136,7 @@ coord_radial <- function(theta = "x",
   }
   if (lifecycle::is_present(direction)) {
     deprecate_warn0(
-      "3.5.2", "coord_radial(direction)", "coord_radial(reverse)"
+      "4.0.0", "coord_radial(direction)", "coord_radial(reverse)"
     )
     reverse <- switch(reverse, "r" = "thetar", "theta")
   }
diff --git a/R/coord-transform.R b/R/coord-transform.R
@@ -113,7 +113,7 @@ coord_transform <- function(x = "identity", y = "identity", xlim = NULL, ylim =
 #' @export
 coord_trans <- function(...) {
   deprecate_soft0(
-    "3.5.2",
+    "4.0.0",
     "coord_trans()",
     "coord_transform()"
   )
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
@@ -569,7 +569,7 @@ wrap_layout <- function(id, dims, dir) {
     # Should only occur when `as.table` was not incorporated into `dir`
     dir <- switch(dir, h = "lt", v = "tl")
     deprecate_soft0(
-      "3.5.2",
+      "4.0.0",
       what = I("Internal use of `dir = \"h\"` and `dir = \"v\"` in `facet_wrap()`"),
       details = I(c(
         "The `dir` argument should incorporate the `as.table` argument.",
diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R
@@ -241,7 +241,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
   setup_params = function(data, params) {
     if ("fatten" %in% names(params)) {
       deprecate_soft0(
-        "3.6.0", "geom_boxplot(fatten)",
+        "4.0.0", "geom_boxplot(fatten)",
         "geom_boxplot(median.linewidth)"
       )
     } else {
diff --git a/R/geom-contour.R b/R/geom-contour.R
@@ -5,7 +5,13 @@
 #' @include geom-path.R
 GeomContour <- ggproto(
   "GeomContour", GeomPath,
-  default_aes = aes(weight = 1, !!!GeomPath$default_aes)
+  default_aes = aes(
+    weight = 1,
+    colour = from_theme(colour %||% accent),
+    linewidth = from_theme(linewidth),
+    linetype = from_theme(linetype),
+    alpha = NA
+  )
 )
 
 #' @rdname Geom
diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R
@@ -62,7 +62,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   setup_params = function(data, params) {
     if (lifecycle::is_present(params$fatten %||% deprecated())) {
       deprecate_soft0(
-        "3.6.0", "geom_crossbar(fatten)",
+        "4.0.0", "geom_crossbar(fatten)",
         "geom_crossbar(middle.linewidth)"
       )
     } else {
diff --git a/R/geom-density.R b/R/geom-density.R
@@ -76,7 +76,7 @@ GeomDensity <- ggproto(
 #'   geom_density(position = "fill")
 #' }
 geom_density <- make_constructor(
-  GeomDensity, stat = "density",
+  GeomDensity, stat = "density", outline.type = "upper",
   checks = exprs(
     outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full"))
   )
diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R
@@ -18,10 +18,19 @@ GeomErrorbar <- ggproto(
   required_aes = c("x|y", "ymin|xmin", "ymax|xmax"),
 
   setup_params = function(data, params) {
-    GeomLinerange$setup_params(data, params)
+    params <- GeomLinerange$setup_params(data, params)
+    if (
+      isTRUE(params$flipped_aes) &&
+      isTRUE("height" %in% names(params)) &&
+      !isTRUE("width" %in% names(params))
+    ) {
+      params <- rename(params, c(height = "width"))
+      cli::cli_inform("{.arg height} was translated to {.arg width}.")
+    }
+    params
   },
 
-  extra_params = c("na.rm", "orientation"),
+  extra_params = c("na.rm", "orientation", "height"),
 
   setup_data = function(self, data, params) {
     data$flipped_aes <- params$flipped_aes
@@ -69,7 +78,7 @@ GeomErrorbarh <- ggproto(
   "GeomErrorbarh", GeomErrorbar,
   setup_params = function(data, params) {
     deprecate_soft0(
-      "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
+      "4.0.0", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
       id = "no-more-errorbarh"
     )
     GeomLinerange$setup_params(data, params)
@@ -87,7 +96,7 @@ geom_errorbar <- make_constructor(GeomErrorbar, orientation = NA)
 #' `geom_errorbar(orientation = "y")` instead.
 geom_errorbarh <- function(..., orientation = "y") {
   deprecate_soft0(
-    "3.5.2", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
+    "4.0.0", "geom_errobarh()", "geom_errorbar(orientation = \"y\")",
     id = "no-more-errorbarh"
   )
   geom_errorbar(..., orientation = orientation)
diff --git a/R/geom-label.R b/R/geom-label.R
@@ -28,7 +28,7 @@ geom_label <- function(mapping = NULL, data = NULL,
 
   extra_args <- list2(...)
   if (lifecycle::is_present(label.size)) {
-    deprecate_warn0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)")
+    deprecate_soft0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)")
     extra_args$linewidth <- extra_args$linewidth %||% label.size
   }
 
diff --git a/R/geom-path.R b/R/geom-path.R
@@ -6,7 +6,7 @@ GeomPath <- ggproto("GeomPath", Geom,
   required_aes = c("x", "y"),
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA
diff --git a/R/geom-pointrange.R b/R/geom-pointrange.R
@@ -16,7 +16,7 @@ GeomPointrange <- ggproto("GeomPointrange", Geom,
 
   setup_params = function(data, params) {
     if (lifecycle::is_present(params$fatten %||% deprecated())) {
-      deprecate_soft0("3.6.0", "geom_pointrange(fatten)", I("the `size` aesthetic"))
+      deprecate_soft0("4.0.0", "geom_pointrange(fatten)", I("the `size` aesthetic"))
     } else {
       # For backward compatibility reasons
       params$fatten <- 4
diff --git a/R/geom-violin.R b/R/geom-violin.R
@@ -111,7 +111,7 @@ geom_violin <- function(mapping = NULL, data = NULL,
   extra <- list()
   if (lifecycle::is_present(draw_quantiles)) {
     deprecate_soft0(
-      "3.6.0",
+      "4.0.0",
       what = "geom_violin(draw_quantiles)",
       with = "geom_violin(quantiles.linetype)"
     )
diff --git a/R/guide-colorsteps.R b/R/guide-colorsteps.R
@@ -194,7 +194,7 @@ GuideColoursteps <- ggproto(
     params$title <- scale$make_title(params$title, scale$name, title)
 
     limits <- c(params$decor$min[1], params$decor$max[nrow(params$decor)])
-    if (params$reverse) {
+    if (isTRUE(params$reverse)) {
       limits <- rev(limits)
     }
     params$key$.value <- rescale(params$key$.value, from = limits)
diff --git a/R/guides-.R b/R/guides-.R
@@ -274,7 +274,7 @@ Guides <- ggproto(
   #
   # The resulting guide is then drawn in ggplot_gtable
 
-  build = function(self, scales, layers, labels, layer_data, theme = theme()) {
+  build = function(self, scales, layers, labels, layer_data, theme = NULL) {
 
     # Empty guides list
     custom <- self$get_custom()
@@ -300,6 +300,7 @@ Guides <- ggproto(
     }
 
     # Merge and process layers
+    theme <- theme %||% theme()
     guides$merge()
     guides$process_layers(layers, layer_data, theme)
     if (length(guides$guides) == 0) {
diff --git a/R/labels.R b/R/labels.R
@@ -78,7 +78,8 @@ setup_plot_labels <- function(plot, layers, data) {
   # `geom_function()`. We can display these labels anyway, so we include them.
   plot_labels  <- plot@labels
   known_labels <- c(names(labels), fn_fmls_names(labs), "x", "y")
-  extra_labels <- setdiff(names(plot_labels), known_labels)
+  extra_labels <- names(plot_labels)[lengths(plot_labels) > 0]
+  extra_labels <- setdiff(extra_labels, known_labels)
 
   if (length(extra_labels) > 0) {
 
@@ -92,7 +93,7 @@ setup_plot_labels <- function(plot, layers, data) {
     extra_labels <- paste0("{.field ", extra_labels, "} : ", warn_labels)
     names(extra_labels) <- rep("*", length(extra_labels))
 
-    cli::cli_warn(c(
+    cli::cli_inform(c(
       "Ignoring unknown labels:",
       extra_labels
     ))
diff --git a/R/layer-sf.R b/R/layer-sf.R
@@ -78,7 +78,12 @@ LayerSf <- ggproto("LayerSf", Layer,
 geom_column <- function(data) {
   w <- which(vapply(data, inherits, TRUE, what = "sfc"))
   if (length(w) == 0) {
-    "geometry" # avoids breaks when objects without geometry list-column are examined
+    if (!is.character(data[["geometry"]])) {
+      "geometry" # avoids breaks when objects without geometry list-column are examined
+    } else {
+      # Avoids a rare case where computed_geom_params$legend is present but there is no actual geometry column
+      ""
+    }
   } else {
     # this may not be best in case more than one geometry list-column is present:
     if (length(w) > 1)
diff --git a/R/layer.R b/R/layer.R
@@ -941,7 +941,7 @@ set_draw_key <- function(geom, draw_key = NULL) {
   }
   draw_key <- match.fun(draw_key)
 
-  ggproto("", geom, draw_key = draw_key)
+  ggproto(NULL, geom, draw_key = draw_key)
 }
 
 cleanup_mismatched_data <- function(data, n, fun) {
diff --git a/R/plot-build.R b/R/plot-build.R
@@ -317,13 +317,13 @@ S7::method(gtable_ggplot, class_ggplot_built) <- function(data) {
 # TODO: the S3 generic should be phased out once S7 is adopted more widely
 #' @rdname gtable_ggplot
 #' @export
-ggplot_gtable <- function(plot) {
+ggplot_gtable <- function(data) {
   UseMethod("ggplot_gtable")
 }
 
 #' @export
-ggplot_gtable.default <- function(plot) {
-  gtable_ggplot(plot)
+ggplot_gtable.default <- function(data) {
+  gtable_ggplot(data)
 }
 
 #' Generate a ggplot2 plot grob.
diff --git a/R/plot-construction.R b/R/plot-construction.R
@@ -24,6 +24,7 @@
 #' @param e1 An object of class [ggplot()] or a [theme()].
 #' @param e2 A plot component, as described below.
 #' @seealso [theme()]
+#' @aliases +.gg
 #' @rdname gg-add
 #' @export
 #' @examples
@@ -135,6 +136,10 @@ S7::method(update_ggplot, list(S7::class_any, class_ggplot)) <-
   function(object, plot, object_name, ...) {
 
     if (!S7::S7_inherits(object) && inherits(object, "theme")) {
+      # This is a contingency for patchwork/#438
+      if (length(object) == 0) {
+        return(plot)
+      }
       # For backward compatibility, we try to cast old S3 themes (lists with
       # the class 'theme') to proper themes. People *should* use `theme()`,
       # so we should be pushy here.
diff --git a/R/plot.R b/R/plot.R
@@ -276,13 +276,14 @@ S7::method(plot, class_ggplot) <- `print.ggplot2::ggplot`
 `[[<-.ggplot2::gg` <- `$<-.ggplot2::gg`
 
 #' @importFrom S7 convert
-S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <-
-  function(from, to) {
-    S7::props(from)
-  }
-
 # S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list`
 # Wrap in `local()` to provide a temp environment which throws away the attachment
 local({
-  S7::method(as.list, class_ggplot) <- function(x, ...) convert(x, S7::class_list)
+  S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <-
+    function(from, to) {
+      S7::props(from)
+    }
+
+  S7::method(as.list, class_ggplot) <-
+    function(x, ...) convert(x, S7::class_list)
 })
diff --git a/R/position-dodge.R b/R/position-dodge.R
@@ -152,7 +152,7 @@ PositionDodge <- ggproto("PositionDodge", Position,
     data$order <- xtfrm( # xtfrm makes anything 'sortable'
       data$order %||% ave(data$group, data$x, data$PANEL, FUN = match_sorted)
     )
-    if (params$reverse) {
+    if (isTRUE(params$reverse)) {
       data$order <- -data$order
     }
     if (is.null(params$n)) { # preserve = "total"
diff --git a/R/position-stack.R b/R/position-stack.R
@@ -154,7 +154,7 @@ PositionStack <- ggproto("PositionStack", Position,
     flipped_aes <- has_flipped_aes(data)
     data <- flip_data(data, flipped_aes)
     var <- self$var %||% stack_var(data)
-    if (!vec_duplicate_any(data$x)) {
+    if (!vec_duplicate_any(data$x)  && !isTRUE(self$fill)) {
       # We skip stacking when all data have different x positions so that
       # there is nothing to stack
       var <- NULL
diff --git a/R/scale-.R b/R/scale-.R
@@ -104,7 +104,7 @@
 continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, name = waiver(),
                              breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL,
                              labels = waiver(), limits = NULL, rescaler = rescale,
-                             oob = censor, expand = waiver(), na.value = NA_real_,
+                             oob = censor, expand = waiver(), na.value = NA,
                              transform = "identity", trans = deprecated(),
                              guide = "legend", position = "left",
                              call = caller_call(),
@@ -1331,7 +1331,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       vec_slice(pal, match(as.character(x), limits, nomatch = vec_size(pal)))
 
     if (!is.na(na_value)) {
-      vec_slice(pal_match, is.na(x)) <- na_value
+      vec_slice(pal_match, vec_detect_missing(x)) <- na_value
     }
     pal_match
   },
diff --git a/R/stat-summary-2d.R b/R/stat-summary-2d.R
@@ -15,7 +15,7 @@ StatSummary2d <- ggproto(
       params$drop <- !identical(params$drop, "none")
     }
 
-    params <- fix_bin_params(params, fun = snake_class(self), version = "3.5.2")
+    params <- fix_bin_params(params, fun = snake_class(self), version = "4.0.0")
     vars <- c("origin", "binwidth", "breaks", "center", "boundary")
     params[vars] <- lapply(params[vars], dual_param, default = NULL)
     params$closed <- dual_param(params$closed, list(x = "right", y = "right"))
diff --git a/R/stat-summary-bin.R b/R/stat-summary-bin.R
@@ -108,6 +108,13 @@ make_summary_fun <- function(fun.data, fun, fun.max, fun.min, fun.args) {
   force(fun.min)
   force(fun.args)
 
+  as_function <- function(x) {
+    if (is.character(x)) {
+      x <- match.fun(x)
+    }
+    rlang::as_function(x)
+  }
+
   if (!is.null(fun.data)) {
     # Function that takes complete data frame as input
     fun.data <- as_function(fun.data)
diff --git a/R/stat-ydensity.R b/R/stat-ydensity.R
@@ -12,7 +12,7 @@ StatYdensity <- ggproto(
 
     if (!is.null(params$draw_quantiles)) {
       deprecate_soft0(
-        "3.6.0",
+        "4.0.0",
         what = "stat_ydensity(draw_quantiles)",
         with = "stat_ydensity(quantiles)"
       )
diff --git a/R/theme-defaults.R b/R/theme-defaults.R
diff --git a/R/theme.R b/R/theme.R
diff --git a/man/aes_.Rd b/man/aes_.Rd
diff --git a/man/geom_density.Rd b/man/geom_density.Rd
diff --git a/man/gg-add.Rd b/man/gg-add.Rd
diff --git a/man/gtable_ggplot.Rd b/man/gtable_ggplot.Rd
diff --git a/revdep/README.md b/revdep/README.md
diff --git a/revdep/cran.md b/revdep/cran.md
diff --git a/revdep/failures.md b/revdep/failures.md
diff --git a/revdep/problems.md b/revdep/problems.md
diff --git a/tests/testthat/_snaps/labels.md b/tests/testthat/_snaps/labels.md
diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R
diff --git a/tests/testthat/test-position-stack.R b/tests/testthat/test-position-stack.R

Original file line number	Diff line number	Diff line change
`@@ -19,7 +19,17 @@ unrowname <- function(x) {`
`19`	`19`	`} else if (is.matrix(x)) {`
`20`	`20`	`dimnames(x)[1] <- list(NULL)`
`21`	`21`	`} else {`
`22`		`- cli::cli_abort("Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.")`
	`22`	`+ try_fetch(`
	`23`	`+ {`
	`24`	`+ rownames(x) <- NULL`
	`25`	`+ },`
	`26`	`+ error = function(cnd) {`
	`27`	`+ cli::cli_abort(`
	`28`	`+ "Can only remove rownames from {.cls data.frame} and {.cls matrix} objects.",`
	`29`	`+ parent = cnd`
	`30`	`+ )`
	`31`	`+ }`
	`32`	`+ )`
`23`	`33`	`}`
`24`	`34`	`x`
`25`	`35`	`}`
Original file line number	Diff line number	Diff line change
`@@ -136,7 +136,7 @@ coord_radial <- function(theta = "x",`
`136`	`136`	`}`
`137`	`137`	`if (lifecycle::is_present(direction)) {`
`138`	`138`	`deprecate_warn0(`
`139`		`- "3.5.2", "coord_radial(direction)", "coord_radial(reverse)"`
	`139`	`+ "4.0.0", "coord_radial(direction)", "coord_radial(reverse)"`
`140`	`140`	`)`
`141`	`141`	`reverse <- switch(reverse, "r" = "thetar", "theta")`
`142`	`142`	`}`
Original file line number	Diff line number	Diff line change
`@@ -113,7 +113,7 @@ coord_transform <- function(x = "identity", y = "identity", xlim = NULL, ylim =`
`113`	`113`	`#' @export`
`114`	`114`	`coord_trans <- function(...) {`
`115`	`115`	`deprecate_soft0(`
`116`		`- "3.5.2",`
	`116`	`+ "4.0.0",`
`117`	`117`	`"coord_trans()",`
`118`	`118`	`"coord_transform()"`
`119`	`119`	`)`
Original file line number	Diff line number	Diff line change
`@@ -241,7 +241,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,`
`241`	`241`	`setup_params = function(data, params) {`
`242`	`242`	`if ("fatten" %in% names(params)) {`
`243`	`243`	`deprecate_soft0(`
`244`		`- "3.6.0", "geom_boxplot(fatten)",`
	`244`	`+ "4.0.0", "geom_boxplot(fatten)",`
`245`	`245`	`"geom_boxplot(median.linewidth)"`
`246`	`246`	`)`
`247`	`247`	`} else {`
Original file line number	Diff line number	Diff line change
`@@ -62,7 +62,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,`
`62`	`62`	`setup_params = function(data, params) {`
`63`	`63`	`if (lifecycle::is_present(params$fatten %\|\|% deprecated())) {`
`64`	`64`	`deprecate_soft0(`
`65`		`- "3.6.0", "geom_crossbar(fatten)",`
	`65`	`+ "4.0.0", "geom_crossbar(fatten)",`
`66`	`66`	`"geom_crossbar(middle.linewidth)"`
`67`	`67`	`)`
`68`	`68`	`} else {`
Original file line number	Diff line number	Diff line change
`@@ -76,7 +76,7 @@ GeomDensity <- ggproto(`
`76`	`76`	`#' geom_density(position = "fill")`
`77`	`77`	`#' }`
`78`	`78`	`geom_density <- make_constructor(`
`79`		`- GeomDensity, stat = "density",`
	`79`	`+ GeomDensity, stat = "density", outline.type = "upper",`
`80`	`80`	`checks = exprs(`
`81`	`81`	`outline.type <- arg_match0(outline.type, c("both", "upper", "lower", "full"))`
`82`	`82`	`)`