More aesthetics for geom_label()

R/geom-label.R

@@ -2,7 +2,8 @@
 #' @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")` Please use `linewidth` to set the width of the border.
+#' @param border.colour,border.color Colour of the label's border. If `NULL` (default), it will fall back to the text colour. `border.color` is an alias.
 geom_label <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "identity",
                        ...,
@@ -11,11 +12,13 @@ geom_label <- function(mapping = NULL, data = NULL,
                        nudge_y = 0,
                        label.padding = unit(0.25, "lines"),
                        label.r = unit(0.15, "lines"),
-                       label.size = 0.25,
+                       label.size = deprecated(),
                        size.unit = "mm",
+                       border.colour = NULL,
                        na.rm = FALSE,
                        show.legend = NA,
-                       inherit.aes = TRUE) {
+                       inherit.aes = TRUE,
+                       border.color = border.colour) {
   if (!missing(nudge_x) || !missing(nudge_y)) {
     if (!missing(position)) {
       cli::cli_abort(c(
@@ -27,6 +30,10 @@ geom_label <- function(mapping = NULL, data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
+  if (lifecycle::is_present(label.size)) {
+    deprecate_warn0("3.5.0", "geom_label(label.size)", "geom_label(linewidth)")
+  }
+
   layer(
     data = data,
     mapping = mapping,
@@ -39,8 +46,8 @@ 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.colour %||% border.color,
       na.rm = na.rm,
       ...
     )
@@ -58,15 +65,15 @@ GeomLabel <- ggproto("GeomLabel", Geom,
   default_aes = aes(
     colour = "black", fill = "white", size = 3.88, angle = 0,
     hjust = 0.5, vjust = 0.5, alpha = NA, family = "", fontface = 1,
-    lineheight = 1.2
+    lineheight = 1.2, linetype = 1, linewidth = 0.25
   ),
 
   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,
-                        size.unit = "mm") {
+                        size.unit = "mm",
+                        border.colour = NULL) {
     lab <- data$label
     if (parse) {
       lab <- parse_safe(as.character(lab))
@@ -102,9 +109,10 @@ GeomLabel <- ggproto("GeomLabel", Geom,
           lineheight = row$lineheight
         ),
         rect.gp = gpar(
-          col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour,
+          col = ifelse(row$linewidth == 0, NA, border.colour %||% row$colour),
           fill = alpha(row$fill, row$alpha),
-          lwd = label.size * .pt
+          lty = row$linetype,
+          lwd = row$linewidth * .pt
         )
       )
     })

R/geom-text.R

@@ -89,6 +89,20 @@
 #'   scale_colour_discrete(l = 40)
 #' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold")
 #'
+#' # If border.color is NULL or not set, the border will use the text color
+#' p + geom_label(aes(colour = factor(cyl)))
+#'
+#' # Alternatively, border.color can have a static value
+#' p + geom_label(aes(colour = factor(cyl)), border.colour = "black")
+#'
+#' # Use linetype and linewidth aesthetics to add highlights
+#' p + 
+#'  geom_label(
+#'    aes(fill = factor(cyl), linetype = qsec < 15),
+#'    border.colour = "black", colour = "white"
+#'  ) +
+#'  scale_linetype_manual(values = c("solid", "blank"), limits = TRUE)
+#'
 #' p + geom_text(aes(size = wt))
 #' # Scale height of text, rather than sqrt(height)
 #' p +

R/legend-draw.R

@@ -252,9 +252,29 @@ draw_key_text <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_label <- function(data, params, size) {
-  grobTree(
-    draw_key_rect(data, list()),
-    draw_key_text(data, list())
+  if(is.null(params$label.padding)) params$label.padding <- unit(0.25, "lines")
+  if(length(params$label.padding) == 1) params$label.padding[2:4] <- params$label.padding
+
+  labelGrob(
+    label = data$label %||% "a",
+    x = 0.5,
+    y = 0.5,
+    padding = params$label.padding,
+    r = data$label.r %||% unit(0.1, "snpc"),
+    angle = data$angle %||% 0,
+    text.gp = gpar(
+      col = alpha(data$colour %||% "white", data$alpha),
+      fontfamily = data$family %||% "",
+      fontface = data$fontface %||% 1,
+      fontsize = (data$size %||% 3.88) * .pt
+    ),
+    rect.gp = gpar(
+      col = alpha(params$border.colour %||% params$border.color %||% data$colour %||% "black", data$alpha),
+      fill = alpha(data$fill %||% "white", data$alpha),
+      lty = data$linetype,
+      lwd = data$linewidth * .pt
+    ),
+    vp = NULL
   )
 }