More aesthetics for geom_label()

R/geom-label.R

@@ -2,7 +2,7 @@
 #' @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`. Size of label border, in mm.
 geom_label <- function(mapping = NULL, data = NULL,
                        stat = "identity", position = "identity",
                        ...,
@@ -27,6 +27,10 @@ geom_label <- function(mapping = NULL, data = NULL,
     position <- position_nudge(nudge_x, nudge_y)
   }
 
+  if (!missing(label.size)) {
+    message("`label.size` is deprecated. Please use `linewidth` in the future.")
+  }
+
   layer(
     data = data,
     mapping = mapping,
@@ -58,15 +62,17 @@ 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 = "solid", 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,
+                        border_color = border_colour) {
     lab <- data$label
     if (parse) {
       lab <- parse_safe(as.character(lab))
@@ -102,9 +108,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 %||% border_color %||% row$colour),
           fill = alpha(row$fill, row$alpha),
-          lwd = label.size * .pt
+          lty = row$linetype,
+          lwd = (row$linewidth %||% label.size) * .pt
         )
       )
     })

R/geom-text.R

@@ -89,6 +89,33 @@
 #'   scale_colour_discrete(l = 40)
 #' p + geom_label(aes(fill = factor(cyl)), colour = "white", fontface = "bold")
 #'
+#' # Add aesthetics to the border for geom_label
+#' ggplot(data.frame(x = 1:10, y = 1:10)) +
+#'   geom_label(aes(
+#'     label=month.abb[x],
+#'     x=x,
+#'     y=y,
+#'     color = factor(x%%3),
+#'     linewidth = x%%2,
+#'     linetype = factor(x%%3)),
+#'     fill = NA) +
+#' scale_linewidth(range=c(0.5, 1.5)) +
+#' scale_linetype_manual(values=c("solid", "blank", "dotted"))
+#'
+#' # Override the border color
+#' ggplot(data.frame(x = 1:10, y = 1:10)) +
+#'   geom_label(aes(
+#'     label=month.abb[x],
+#'     x=x,
+#'     y=y,
+#'     color = factor(x%%3),
+#'     linewidth=x%%2,
+#'     linetype=factor(x%%3)),
+#'     border_color = "red",
+#'     fill=NA) +
+#' scale_linewidth(range=c(0.5, 1.5)) +
+#' scale_linetype_manual(values=c("solid", "blank", "dotted"))
+#'
 #' p + geom_text(aes(size = wt))
 #' # Scale height of text, rather than sqrt(height)
 #' p +

R/legend-draw.R

@@ -252,9 +252,31 @@ 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(data$label))         data$label <- "a"
+  if(is.null(data$label.r))       data$label.r <- unit(0.1, "snpc")
+  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,
+    x = 0.5,
+    y = 0.5,
+    padding = params$label.padding,
+    r = data$label.r,
+    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 %||% "black", data$alpha),
+      fill = alpha(data$fill %||% "white", data$alpha),
+      lty = data$linetype,
+      lwd = (data$linewidth %||%  params$label.size) * .pt
+    ),
+    vp = NULL
   )
 }