Merge branch 'main' into after_stat_legend_data_resolving

Author: teunbrand

NAMESPACE

@@ -20,6 +20,8 @@ S3method(c,mapped_discrete)
 S3method(drawDetails,zeroGrob)
 S3method(element_grob,element_blank)
 S3method(element_grob,element_line)
+S3method(element_grob,element_point)
+S3method(element_grob,element_polygon)
 S3method(element_grob,element_rect)
 S3method(element_grob,element_text)
 S3method(format,ggproto)
@@ -346,6 +348,8 @@ export(element_blank)
 export(element_geom)
 export(element_grob)
 export(element_line)
+export(element_point)
+export(element_polygon)
 export(element_rect)
 export(element_render)
 export(element_text)

NEWS.md

@@ -1,5 +1,19 @@
 # ggplot2 (development version)
 
+* New parameters for `geom_label()` (@teunbrand and @steveharoz, #5365):
+  * The `linewidth` aesthetic is now applied and replaces the `label.size` 
+    argument.
+  * The `linetype` aesthetic is now applied.
+  * New `border.colour` argument to set the colour of borders.
+  * New `text.colour` argument to set the colour of text.
+* New `element_point()` and `element_polygon()` that can be given to 
+  `theme(point, polygon)` as an extension point (@teunbrand, #6248).
+* Turned off fallback for `size` to `linewidth` translation in 
+  `geom_bar()`/`geom_col()` (#4848).
+* `coord_radial()` now displays no axis instead of throwing an error when
+  a scale has no breaks (@teunbrand, #6271).
+* The `fatten` argument has been deprecated in `geom_boxplot()`, 
+  `geom_crossbar()` and `geom_pointrange()` (@teunbrand, #4881).
 * Axis labels are now preserved better when using `coord_sf(expand = TRUE)` and
   graticule lines are straight but do not meet the edge (@teunbrand, #2985).
 * Attempt to boost detail in `coord_polar()` and `coord_radial()` near the 
@@ -290,6 +304,10 @@
 * All scales now expose the `aesthetics` parameter (@teunbrand, #5841)
 * Staged expressions are handled more gracefully if legends cannot resolve them 
   (@teunbrand, #6264).
+* New `theme(legend.key.justification)` to control the alignment of legend keys 
+  (@teunbrand, #3669). 
+* Added `scale_{x/y}_time(date_breaks, date_minor_breaks, date_labels)` 
+  (@teunbrand, #4335).
 
 # ggplot2 3.5.1
 

R/coord-radial.R

@@ -250,11 +250,18 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     names(gdefs) <- aesthetics
 
     # Train theta guide
-    for (t in intersect(c("theta", "theta.sec"), aesthetics[!empty])) {
-      gdefs[[t]] <- guides[[t]]$train(gdefs[[t]], panel_params[[t]])
-      gdefs[[t]] <- guides[[t]]$transform(gdefs[[t]], self, panel_params)
-      gdefs[[t]] <- guides[[t]]$get_layer_key(gdefs[[t]], layers)
-    }
+    t <- intersect(c("theta", "theta.sec"), aesthetics[!empty])
+    gdefs[t] <- Map(
+      function(guide, guide_param, scale) {
+        guide_param$theme_suffix <- "theta"
+        guide_param <- guide$train(guide_param, scale)
+        guide_param <- guide$transform(guide_param, self, panel_params)
+        guide_param <- guide$get_layer_key(guide_param, layers)
+      },
+      guide = guides[t],
+      guide_param = gdefs[t],
+      scale = panel_params[t]
+    )
 
     if (!isFALSE(self$r_axis_inside)) {
       # For radial axis, we need to pretend that rotation starts at 0 and
@@ -269,17 +276,18 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     temp <- modify_list(panel_params, mod)
 
     # Train radial guide
-    for (r in intersect(c("r", "r.sec"), aesthetics[!empty])) {
-      gdefs[[r]] <- guides[[r]]$train(gdefs[[r]], panel_params[[r]])
-      gdefs[[r]] <- guides[[r]]$transform(gdefs[[r]], self, temp) # Use temp
-      gdefs[[r]] <- guides[[r]]$get_layer_key(gdefs[[r]], layers)
-    }
-
-    # Set theme suffixes
-    gdefs$theta$theme_suffix     <- "theta"
-    gdefs$theta.sec$theme_suffix <- "theta"
-    gdefs$r$theme_suffix         <- "r"
-    gdefs$r.sec$theme_suffix     <- "r"
+    r <- intersect(c("r", "r.sec"), aesthetics[!empty])
+    gdefs[r] <- Map(
+      function(guide, guide_param, scale) {
+        guide_param$theme_suffix <- "r"
+        guide_param <- guide$train(guide_param, scale)
+        guide_param <- guide$transform(guide_param, self, temp)
+        guide_param <- guide$get_layer_key(guide_param, layers)
+      },
+      guide = guides[r],
+      guide_param = gdefs[r],
+      scale = panel_params[r]
+    )
 
     panel_params$guides$update_params(gdefs)
     panel_params

R/facet-grid-.R

@@ -309,7 +309,9 @@ FacetGrid <- ggproto("FacetGrid", Facet,
         params$margins
       )
       # Apply recycling on original data to fit margins
-      data <- vec_slice(data, facet_vals$.index)
+      # We're using base subsetting here because `data` might have a superclass
+      # that isn't handled well by vctrs::vec_slice
+      data <- data[facet_vals$.index, , drop = FALSE]
       facet_vals$.index <- NULL
     }
 

R/geom-bar.R

@@ -155,5 +155,5 @@ GeomBar <- ggproto("GeomBar", GeomRect,
     flip_data(data, params$flipped_aes)
   },
 
-  rename_size = TRUE
+  rename_size = FALSE
 )

R/geom-boxplot.R

@@ -239,6 +239,15 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
   extra_params = c("na.rm", "orientation", "outliers"),
 
   setup_params = function(data, params) {
+    if ("fatten" %in% names(params)) {
+      deprecate_soft0(
+        "3.6.0", "geom_boxplot(fatten)",
+        "geom_boxplot(median.linewidth)"
+      )
+    } else {
+      # For backward compatibility reasons
+      params$fatten <- 2
+    }
     params$flipped_aes <- has_flipped_aes(data, params)
     params
   },

R/geom-crossbar.R

@@ -17,7 +17,7 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
                           box.color         = NULL,
                           box.linetype      = NULL,
                           box.linewidth     = NULL,
-                          fatten = 2.5,
+                          fatten = deprecated(),
                           na.rm = FALSE,
                           orientation = NA,
                           show.legend = NA,
@@ -60,6 +60,15 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
 #' @export
 GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   setup_params = function(data, params) {
+    if (lifecycle::is_present(params$fatten)) {
+      deprecate_soft0(
+        "3.6.0", "geom_crossbar(fatten)",
+        "geom_crossbar(middle.linewidth)"
+      )
+    } else {
+      # For backward compatibility reasons
+      params$fatten <- 2.5
+    }
     GeomErrorbar$setup_params(data, params)
   },
 

R/geom-label.R

@@ -2,19 +2,36 @@
 #' @rdname geom_text
 #' @param label.padding Amount of padding around label. Defaults to 0.25 lines.
 #' @param label.r Radius of rounded corners. Defaults to 0.15 lines.
-#' @param label.size Size of label border, in mm.
+#' @param label.size `r lifecycle::badge("deprecated")` Replaced by the
+#'   `linewidth` aesthetic. Size of label border, in mm.
+#' @param border.colour,border.color Colour of label border. When `NULL`
+#'   (default), the `colour` aesthetic determines the colour of the label border.
+#'   `border.color` is an alias for `border.colour`.
+#' @param text.colour,text.color Colour of the text. When `NULL` (default), the
+#'   `colour` aesthetic determines the colour of the text. `text.color` is an
+#'   alias for `text.colour`.
 geom_label <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "nudge",
                        ...,
                        parse = FALSE,
                        label.padding = unit(0.25, "lines"),
                        label.r = unit(0.15, "lines"),
-                       label.size = 0.25,
+                       label.size = deprecated(),
+                       border.colour = NULL,
+                       border.color = NULL,
+                       text.colour = NULL,
+                       text.color = NULL,
                        size.unit = "mm",
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
 
+  extra_args <- list2(...)
+  if (lifecycle::is_present(label.size)) {
+    deprecate_warn0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)")
+    extra_args$linewidth <- extra_args$linewidth %||% label.size
+  }
+
   layer(
     data = data,
     mapping = mapping,
@@ -27,10 +44,11 @@ geom_label <- function(mapping = NULL, data = NULL,
       parse = parse,
       label.padding = label.padding,
       label.r = label.r,
-      label.size = label.size,
       size.unit = size.unit,
+      border.colour = border.color %||% border.colour,
+      text.colour = text.color %||% text.colour,
       na.rm = na.rm,
-      ...
+      !!!extra_args
     )
   )
 }
@@ -49,14 +67,17 @@ GeomLabel <- ggproto("GeomLabel", Geom,
     size = from_theme(fontsize),
     angle = 0,
     hjust = 0.5, vjust = 0.5, alpha = NA, fontface = 1,
-    lineheight = 1.2
+    lineheight = 1.2,
+    linewidth = from_theme(borderwidth * 0.5),
+    linetype  = from_theme(bordertype)
   ),
 
   draw_panel = function(self, data, panel_params, coord, parse = FALSE,
                         na.rm = FALSE,
                         label.padding = unit(0.25, "lines"),
                         label.r = unit(0.15, "lines"),
-                        label.size = 0.25,
+                        border.colour = NULL,
+                        text.colour = NULL,
                         size.unit = "mm") {
     lab <- data$label
     if (parse) {
@@ -71,6 +92,12 @@ GeomLabel <- ggproto("GeomLabel", Geom,
     }
 
     size.unit <- resolve_text_unit(size.unit)
+    data$text.colour   <- text.colour %||% data$colour
+    data$border.colour <- border.colour %||% data$colour
+    data$border.colour[data$linewidth == 0] <- NA
+    data$fill <- fill_alpha(data$fill, data$alpha)
+    data$size <- data$size * size.unit
+
 
     grobs <- lapply(seq_len(nrow(data)), function(i) {
       row <- data[i, , drop = FALSE]
@@ -82,16 +109,17 @@ GeomLabel <- ggproto("GeomLabel", Geom,
         r = label.r,
         angle = row$angle,
         text.gp = gg_par(
-          col = row$colour,
-          fontsize = row$size * size.unit,
+          col = row$text.colour,
+          fontsize = row$size,
           fontfamily = row$family,
           fontface = row$fontface,
           lineheight = row$lineheight
         ),
         rect.gp = gg_par(
-          col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour,
-          fill = fill_alpha(row$fill, row$alpha),
-          lwd = label.size
+          col = row$border.colour,
+          fill = row$fill,
+          lwd = row$linewidth,
+          lty = row$linetype
         )
       )
     })

R/geom-linerange.R

@@ -6,9 +6,9 @@
 #' @eval rd_orientation()
 #'
 #' @eval rd_aesthetics("geom", "linerange", "Note that `geom_pointrange()` also understands `size` for the size of the points.")
-#' @param fatten A multiplicative factor used to increase the size of the
-#'   middle bar in `geom_crossbar()` and the middle point in
-#'   `geom_pointrange()`.
+#' @param fatten `r lifecycle::badge("deprecated")`  A multiplicative factor
+#'   used to increase the size of the middle bar in `geom_crossbar()` and the
+#'   middle point in `geom_pointrange()`.
 #' @seealso
 #'  [stat_summary()] for examples of these guys in use,
 #'  [geom_smooth()] for continuous analogue

R/geom-point.R

@@ -148,10 +148,7 @@ GeomPoint <- ggproto("GeomPoint", Geom,
   ),
 
   draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) {
-    if (is.character(data$shape)) {
-      data$shape <- translate_shape_string(data$shape)
-    }
-
+    data$shape <- translate_shape_string(data$shape)
     coords <- coord$transform(data, panel_params)
     ggname("geom_point",
       pointsGrob(
@@ -176,7 +173,8 @@ GeomPoint <- ggproto("GeomPoint", Geom,
 #' given as a character vector into integers that are interpreted by the
 #' grid system.
 #'
-#' @param shape_string A character vector giving point shapes.
+#' @param shape_string A character vector giving point shapes. Non-character
+#'   input will be returned.
 #'
 #' @return An integer vector with translated shapes.
 #' @export
@@ -188,6 +186,9 @@ GeomPoint <- ggproto("GeomPoint", Geom,
 #' # Strings with 1 or less characters are interpreted as symbols
 #' translate_shape_string(c("a", "b", "?"))
 translate_shape_string <- function(shape_string) {
+  if (!is.character(shape_string)) {
+    return(shape_string)
+  }
   # strings of length 0 or 1 are interpreted as symbols by grid
   if (nchar(shape_string[1]) <= 1) {
     return(shape_string)