Additional settings for geom_label() (#6307)

* replace `geom_label(label.size)` with `linewidth` aesthetic

* add `linetype` aesthetic

* add border and text colours

* vectorise some operations

* preserve thinner linewidth

* apply to `geom_sf_labels()` too

* adapt legend key

* document new params

* add test

* add news bullet

Author: teunbrand

NEWS.md

@@ -1,5 +1,11 @@
 # 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 

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-sf.R

@@ -317,12 +317,22 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
                           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,
                           na.rm = FALSE,
                           show.legend = NA,
                           inherit.aes = TRUE,
                           fun.geometry = NULL) {
 
+  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_sf(
     data = data,
     mapping = mapping,
@@ -335,10 +345,11 @@ geom_sf_label <- function(mapping = aes(), data = NULL,
       parse = parse,
       label.padding = label.padding,
       label.r = label.r,
-      label.size = label.size,
       na.rm = na.rm,
       fun.geometry = fun.geometry,
-      ...
+      border.colour = border.color %||% border.colour,
+      text.colour = text.color %||% text.colour,
+      !!!extra_args
     )
   )
 }

R/legend-draw.R

@@ -328,7 +328,6 @@ draw_key_text <- function(data, params, size) {
 #' @rdname draw_key
 draw_key_label <- function(data, params, size) {
   data <- replace_null(unclass(data), label = "a", angle = 0)
-  params$label.size <- params$label.size %||% 0.25
   hjust <- compute_just(data$hjust %||% 0.5)
   vjust <- compute_just(data$vjust %||% 0.5)
   just  <- rotate_just(data$angle, hjust, vjust)
@@ -338,6 +337,7 @@ draw_key_label <- function(data, params, size) {
     face = data$fontface %||% 1,
     size = data$size %||% 3.88
   )
+  lwd <- data$linewidth %||% 0.25
   grob <- labelGrob(
     data$label,
     x = unit(just$hjust, "npc"),
@@ -347,15 +347,16 @@ draw_key_label <- function(data, params, size) {
     padding = padding,
     r = params$label.r %||% unit(0.15, "lines"),
     text.gp = gg_par(
-      col = data$colour %||% "black",
+      col = params$text.colour %||% data$colour %||% "black",
       fontfamily = data$family   %||% "",
       fontface   = data$fontface %||% 1,
       fontsize   = (data$size %||% 3.88) * .pt
     ),
     rect.gp = gg_par(
-      col  = if (isTRUE(all.equal(params$label.size, 0))) NA else data$colour,
+      col  = if (isTRUE(all.equal(lwd, 0))) NA else params$border.colour %||% data$colour %||% "black",
       fill = alpha(data$fill %||% "white", data$alpha),
-      lwd  = params$label.size
+      lwd  = lwd,
+      lty  = data$linetype %||% 1L
     )
   )
   angle  <- deg2rad(data$angle %||% 0)

ggplot2.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: f500cb87-e0be-413f-b396-3eb022932f55
 
 RestoreWorkspace: Default
 SaveWorkspace: Default