Merge branch 'main' into theme_geom_defaults

Author: teunbrand

NEWS.md

@@ -6,6 +6,19 @@
     * 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.
+* `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)
+* `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).
 * geom_sf now accepts shape names (@sierrajohnson, #5808)
@@ -143,6 +156,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
 

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
@@ -243,7 +243,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

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

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)

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)

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

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,

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.

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

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
@@ -678,7 +677,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')])
 }