diff --git a/NAMESPACE b/NAMESPACE index 00905b35e9..21f2e522fa 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 88837e377a..fc37b8305b 100644 --- a/NEWS.md +++ b/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). diff --git a/R/geom-label.R b/R/geom-label.R index dcb56be8f4..9b1842e470 100644 --- a/R/geom-label.R +++ b/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) } diff --git a/R/geom-text.R b/R/geom-text.R index 976c054ef7..a6081e7513 100644 --- a/R/geom-text.R +++ b/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` diff --git a/man/geom_text.Rd b/man/geom_text.Rd index 0b7fe7d714..d74e5879e5 100644 --- a/man/geom_text.Rd +++ b/man/geom_text.Rd @@ -153,9 +153,9 @@ Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. \section{\code{geom_label()}}{ -Currently \code{geom_label()} does not support the \code{check_overlap} argument -or the \code{angle} aesthetic. Also, it is considerably slower than \code{geom_text()}. -The \code{fill} aesthetic controls the background colour of the label. +Currently \code{geom_label()} does not support the \code{check_overlap} argument. Also, +it is considerably slower than \code{geom_text()}. The \code{fill} aesthetic controls +the background colour of the label. } \section{Alignment}{ diff --git a/tests/testthat/_snaps/geom-sf/labels-for-north-carolina.svg b/tests/testthat/_snaps/geom-sf/labels-for-north-carolina.svg index 4bba0503d4..ab6663e489 100644 --- a/tests/testthat/_snaps/geom-sf/labels-for-north-carolina.svg +++ b/tests/testthat/_snaps/geom-sf/labels-for-north-carolina.svg @@ -27,7 +27,7 @@ - + ashe diff --git a/tests/testthat/test-geom-label.R b/tests/testthat/test-geom-label.R index 400ed32437..2504787fd2 100644 --- a/tests/testthat/test-geom-label.R +++ b/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) +})