Improvements to geom_label() (#5030)

* Use `angle` aesthetic in `geom_label()`

* Add news bullet

* Revert unnecessary clip argument

* Add rotation test

* Update docs

* Use text descenders

* Interpret "lines" unit correctly

* Accept visual change

* Update news bullet

* Use titleGrob for label

* Allow margin as padding

* Decommission makeContent method

* Edit NEWS bullet

* Update test

* improve details

Author: teunbrand

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).
 * As an internal change, the `titleGrob()` has been refactored to be faster.
 * The `translate_shape_string()` internal function is now exported for use in
   extensions of point layers (@teunbrand, #5191).

R/geom-label.R

@@ -76,6 +76,9 @@ GeomLabel <- ggproto("GeomLabel", Geom,
     if (is.character(data$hjust)) {
       data$hjust <- compute_just(data$hjust, data$x)
     }
+    if (!inherits(label.padding, "margin")) {
+      label.padding <- rep(label.padding, length.out = 4)
+    }
 
     grobs <- lapply(1:nrow(data), function(i) {
       row <- data[i, , drop = FALSE]
@@ -85,6 +88,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 +113,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 +125,35 @@ 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)
+
+  text <- titleGrob(
+    label = label, hjust = hjust, vjust = vjust, x = x, y = y,
+    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 - (1 - vjust) * descent,
+    width  = widthDetails(text),
+    height = heightDetails(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`

man/geom_text.Rd

@@ -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)
+})