Improvements to geom_label()

NAMESPACE

@@ -109,7 +109,6 @@ S3method(limits,POSIXlt)
 S3method(limits,character)
 S3method(limits,factor)
 S3method(limits,numeric)
-S3method(makeContent,labelgrob)
 S3method(makeContext,dotstackGrob)
 S3method(merge_element,default)
 S3method(merge_element,element)

NEWS.md

@@ -1,5 +1,11 @@
 # ggplot2 (development version)
 
+* `geom_label()` now uses the `angle` aesthetic (@teunbrand, #2785)
+* 'lines' units in `geom_label()`, often used in the `label.padding` argument, 
+  are now are relative to the text size. This causes a visual change, but fixes 
+  a misalignment issue between the textbox and text (@teunbrand, #4753)
+* The `label.padding` argument in `geom_label()` now supports inputs created
+  with the `margin()` function (#5030).
 * Using two ordered factors as facetting variables in 
   `facet_grid(..., as.table = FALSE)` now throws a warning instead of an
   error (@teunbrand, #5109).

R/geom-label.R

@@ -85,6 +85,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
         just = c(row$hjust, row$vjust),
         padding = label.padding,
         r = label.r,
+        angle = row$angle,
         text.gp = gpar(
           col = row$colour,
           fontsize = row$size * .pt,
@@ -109,7 +110,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
 
 labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"),
                       just = "center", padding = unit(0.25, "lines"), r = unit(0.1, "snpc"),
-                      default.units = "npc", name = NULL,
+                      angle = NULL, default.units = "npc", name = NULL,
                       text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) {
 
   if (length(label) != 1) {
@@ -121,32 +122,41 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"),
   if (!is.unit(y))
     y <- unit(y, default.units)
 
-  gTree(label = label, x = x, y = y, just = just, padding = padding, r = r,
-    name = name, text.gp = text.gp, rect.gp = rect.gp, vp = vp, cl = "labelgrob")
-}
+  if (!is.null(angle) & is.null(vp)) {
+    vp <- viewport(
+      angle = angle, x = x, y = y,
+      width = unit(0, "cm"), height = unit(0, "cm"),
+      gp = gpar(fontsize = text.gp$fontsize)
+    )
+    x <- unit(rep(0.5, length(x)), "npc")
+    y <- unit(rep(0.5, length(y)), "npc")
+  }
 
-#' @export
-makeContent.labelgrob <- function(x) {
-  hj <- resolveHJust(x$just, NULL)
-  vj <- resolveVJust(x$just, NULL)
-
-  t <- textGrob(
-    x$label,
-    x$x + 2 * (0.5 - hj) * x$padding,
-    x$y + 2 * (0.5 - vj) * x$padding,
-    just = c(hj, vj),
-    gp = x$text.gp,
-    name = "text"
+  descent <- font_descent(
+    text.gp$fontfamily, text.gp$fontface, text.gp$fontsize, text.gp$cex
+  )
+  hjust <- resolveHJust(just, NULL)
+  vjust <- resolveVJust(just, NULL)
+
+  if (!inherits(padding, "margin")) {
+    padding <- rep(padding, length.out = 4)
+  }
+
+  text <- titleGrob(
+    label = label, hjust = hjust, vjust = vjust,
+    x = x + (0.5 - hjust) * sum(padding[c(2, 4)]),
+    y = y + (0.5 - vjust) * sum(padding[c(1, 3)]),
+    margin = padding, margin_x = TRUE, margin_y = TRUE,
+    gp = text.gp
   )
 
-  r <- roundrectGrob(x$x, x$y, default.units = "native",
-    width = grobWidth(t) + 2 * x$padding,
-    height = grobHeight(t) + 2 * x$padding,
-    just = c(hj, vj),
-    r = x$r,
-    gp = x$rect.gp,
-    name = "box"
+  box <- roundrectGrob(
+    x = x, y = y - 0.5 * descent,
+    width  = grobWidth(text),
+    height = grobHeight(text),
+    just   = c(hjust, vjust),
+    r = r, gp = rect.gp, name = "box"
   )
 
-  setChildren(x, gList(r, t))
+  gTree(children = gList(box, text), name = name, vp = vp)
 }

R/geom-text.r

@@ -25,9 +25,9 @@
 #'
 #' @eval rd_aesthetics("geom", "text")
 #' @section `geom_label()`:
-#' Currently `geom_label()` does not support the `check_overlap` argument
-#' or the `angle` aesthetic. Also, it is considerably slower than `geom_text()`.
-#' The `fill` aesthetic controls the background colour of the label.
+#' Currently `geom_label()` does not support the `check_overlap` argument. Also,
+#' it is considerably slower than `geom_text()`. The `fill` aesthetic controls
+#' the background colour of the label.
 #'
 #' @section Alignment:
 #' You can modify text alignment with the `vjust` and `hjust`

tests/testthat/test-geom-label.R

@@ -2,3 +2,23 @@ test_that("geom_label() throws meaningful errors", {
   expect_snapshot_error(geom_label(position = "jitter", nudge_x = 0.5))
   expect_snapshot_error(labelGrob(label = 1:3))
 })
+
+test_that("geom_label() rotates labels", {
+  df <- data_frame0(
+    x = 1:5,
+    y = 1,
+    lab = c("cat", "dog", "banana", "orange", "tea")
+  )
+
+  angle_in <- c(0, 45, 90, 135, 180)
+
+  p <- ggplot(df, aes(x, y, label = lab)) +
+    geom_label(angle = angle_in)
+
+  vps <- lapply(
+    layer_grob(p, 1)[[1]]$children,
+    `[[`, "vp"
+  )
+  angle_out <- unname(vapply(vps, `[[`, numeric(1), "angle"))
+  expect_equal(angle_in, angle_out)
+})