diff --git a/NEWS.md b/NEWS.md
index 7a14c5e859..88837e377a 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
# ggplot2 (development version)
+* 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).
* Fixed bug in `coord_sf()` where graticule lines didn't obey
diff --git a/R/labeller.R b/R/labeller.R
index 727961d19f..c367a2aa11 100644
--- a/R/labeller.R
+++ b/R/labeller.R
@@ -557,31 +557,12 @@ assemble_strips <- function(grobs, theme, horizontal = TRUE, clip) {
return(grobs)
}
- # Add margins to non-titleGrobs so they behave eqivalently
- grobs[] <- lapply(grobs, function(g) {
- if (inherits(g, "titleGrob")) return(g)
- add_margins(gList(g), grobHeight(g), grobWidth(g), margin_x = TRUE, margin_y = TRUE)
- })
-
if (horizontal) {
- height <- max_height(lapply(grobs, function(x) x$heights[2]))
+ height <- max_height(grobs)
width <- unit(1, "null")
} else {
height <- unit(1, "null")
- width <- max_width(lapply(grobs, function(x) x$widths[2]))
- }
- grobs[] <- lapply(grobs, function(x) {
- # Avoid unit subset assignment to support R 3.2
- x$widths <- unit.c(x$widths[1], width, x$widths[c(-1, -2)])
- x$heights <- unit.c(x$heights[1], height, x$heights[c(-1, -2)])
- x$vp$parent$layout$widths <- unit.c(x$vp$parent$layout$widths[1], width, x$vp$parent$layout$widths[c(-1, -2)])
- x$vp$parent$layout$heights <- unit.c(x$vp$parent$layout$heights[1], height, x$vp$parent$layout$heights[c(-1, -2)])
- x
- })
- if (horizontal) {
- height <- sum(grobs[[1]]$heights)
- } else {
- width <- sum(grobs[[1]]$widths)
+ width <- max_width(grobs)
}
background <- if (horizontal) "strip.background.x" else "strip.background.y"
diff --git a/R/margins.R b/R/margins.R
index b52bf527c1..fe7935431d 100644
--- a/R/margins.R
+++ b/R/margins.R
@@ -12,34 +12,31 @@ is.margin <- function(x) {
inherits(x, "margin")
}
-margin_height <- function(grob, margins) {
- if (is.zero(grob)) return(unit(0, "cm"))
-
- grobHeight(grob) + margins[1] + margins[3]
-}
-
-margin_width <- function(grob, margins) {
- if (is.zero(grob)) return(unit(0, "cm"))
-
- grobWidth(grob) + margins[2] + margins[4]
-}
-
-#' Text grob, height, and width
+#' Create a text grob with the proper location and margins
#'
-#' This function returns a list containing a text grob (and, optionally,
-#' debugging grobs) and the height and width of the text grob.
+#' `titleGrob()` is called when creating titles and labels for axes, legends,
+#' and facet strips.
#'
-#' @param label Either `NULL`, a string (length 1 character vector), or
-#' an expression.
-#' @param x,y x and y locations where the text is to be placed. If `x` and `y`
-#' are `NULL`, `hjust` and `vjust` are used to determine the location.
-#' @inheritParams titleGrob
+#' @param label Text to place on the plot. These maybe axis titles, axis labels,
+#' facet strip titles, etc.
+#' @param x,y x and y locations where the text is to be placed.
+#' @param hjust,vjust Horizontal and vertical justification of the text.
+#' @param angle Angle of rotation of the text.
+#' @param gp Additional graphical parameters in a call to `gpar()`.
+#' @param margin Margins around the text. See [margin()] for more
+#' details.
+#' @param margin_x,margin_y Whether or not to add margins in the x/y direction.
+#' @param debug If `TRUE`, aids visual debugging by drawing a solid
+#' rectangle behind the complete text area, and a point where each label
+#' is anchored.
#'
#' @noRd
-title_spec <- function(label, x, y, hjust, vjust, angle, gp = gpar(),
- debug = FALSE, check.overlap = FALSE) {
-
- if (is.null(label)) return(zeroGrob())
+titleGrob <- function(label, x, y, hjust, vjust, angle = 0, gp = gpar(),
+ margin = NULL, margin_x = FALSE, margin_y = FALSE,
+ debug = FALSE, check.overlap = FALSE) {
+ if (is.null(label)) {
+ return(zeroGrob())
+ }
# We rotate the justifiation values to obtain the correct x and y reference point,
# since hjust and vjust are applied relative to the rotated text frame in textGrob
@@ -48,16 +45,17 @@ title_spec <- function(label, x, y, hjust, vjust, angle, gp = gpar(),
n <- max(length(x), length(y), 1)
x <- x %||% unit(rep(just$hjust, n), "npc")
y <- y %||% unit(rep(just$vjust, n), "npc")
+ if (!is.unit(x)) {
+ x <- unit(x, "npc")
+ }
+ if (!is.unit(y)) {
+ y <- unit(y, "npc")
+ }
- text_grob <- textGrob(
- label,
- x,
- y,
- hjust = hjust,
- vjust = vjust,
- rot = angle,
- gp = gp,
- check.overlap = check.overlap
+ grob <- textGrob(
+ label, x, y,
+ hjust = hjust, vjust = vjust,
+ rot = angle, gp = gp, check.overlap = check.overlap
)
# The grob dimensions don't include the text descenders, so these need to be added
@@ -71,140 +69,78 @@ title_spec <- function(label, x, y, hjust, vjust, angle, gp = gpar(),
# Use trigonometry to calculate grobheight and width for rotated grobs. This is only
# exactly correct when vjust = 1. We need to take the absolute value so we don't make
# the grob smaller when it's flipped over.
- text_height <- unit(1, "grobheight", text_grob) + abs(cos(angle[1] / 180 * pi)) * descent
- text_width <- unit(1, "grobwidth", text_grob) + abs(sin(angle[1] / 180 * pi)) * descent
+ rad <- (angle[1] %% 360) / 180 * pi
+ x_descent <- abs(sin(rad)) * descent
+ y_descent <- abs(cos(rad)) * descent
- if (isTRUE(debug)) {
- children <- gList(
- rectGrob(gp = gpar(fill = "cornsilk", col = NA)),
- pointsGrob(x, y, pch = 20, gp = gpar(col = "gold")),
- text_grob
- )
- } else {
- children <- gList(text_grob)
- }
-
- list(
- text_grob = children,
- text_height = text_height,
- text_width = text_width
- )
-}
-
-#' Add margins
-#'
-#' Given a text grob, `add_margins()` adds margins around the grob in the
-#' directions determined by `margin_x` and `margin_y`.
-#'
-#' @param grob A gList containing a grob, such as a text grob
-#' @param height,width Usually the height and width of the text grob. Passed as
-#' separate arguments from the grob itself because in the special case of
-#' facet strip labels each set of strips should share the same height and
-#' width, even if the labels are of different length.
-#' @inheritParams titleGrob
-#'
-#' @noRd
-add_margins <- function(grob, height, width, margin = NULL,
- gp = gpar(), margin_x = FALSE, margin_y = FALSE) {
+ # Set text size to actual size including descenders
+ width <- unit(1, "grobwidth", grob) + x_descent
+ height <- unit(1, "grobheight", grob) + y_descent
+ # Resolve margin
if (is.null(margin)) {
margin <- margin(0, 0, 0, 0)
}
+ margin_x <- isTRUE(margin_x)
+ margin_y <- isTRUE(margin_y)
+
+ # Initialise new values for position and dimensions
+ new_x <- NULL
+ new_y <- NULL
+ new_width <- NULL
+ new_height <- NULL
+
+ # Calculate new x/width
+ if (margin_x) {
+ new_width <- unit.c(margin[4], width, margin[2])
+ new_x <- x - margin[2] * just$hjust + margin[4] * (1 - just$hjust)
+ }
- if (margin_x && margin_y) {
- widths <- unit.c(margin[4], width, margin[2])
- heights <- unit.c(margin[1], height, margin[3])
+ # Calculate new y/height
+ if (margin_y) {
+ new_height <- unit.c(margin[1], height, margin[3])
+ new_y <- y - margin[1] * just$vjust + margin[3] * (1 - just$vjust)
+ }
- vp <- viewport(
- layout = grid.layout(3, 3, heights = heights, widths = widths),
- gp = gp
- )
- child_vp <- viewport(layout.pos.row = 2, layout.pos.col = 2)
- } else if (margin_x) {
- widths <- unit.c(margin[4], width, margin[2])
- vp <- viewport(layout = grid.layout(1, 3, widths = widths), gp = gp)
- child_vp <- viewport(layout.pos.col = 2)
+ # If only one margin is set, the other dimension is a null unit
+ if (xor(margin_x, margin_y)) {
+ new_width <- new_width %||% unit(1, "null")
+ new_height <- new_height %||% unit(1, "null")
+ }
- heights <- unit(1, "null")
- } else if (margin_y) {
- heights <- unit.c(margin[1], height, margin[3])
+ # If we haven't touched the new positions/dimensions, use the previous ones
+ new_width <- new_width %||% width
+ new_height <- new_height %||% height
+ x <- new_x %||% x
+ y <- new_y %||% y
- vp <- viewport(layout = grid.layout(3, 1, heights = heights), gp = gp)
- child_vp <- viewport(layout.pos.row = 2)
+ # Adjust the grob
+ grob$x <- x
+ grob$y <- y
- widths <- unit(1, "null")
- } else {
- widths <- width
- heights <- height
- return(
- gTree(
- children = grob,
- widths = widths,
- heights = heights,
- cl = "titleGrob"
- )
+ # Add debug rectangles/points if necessary
+ if (isTRUE(debug)) {
+ children <- gList(
+ rectGrob(
+ x = x, y = y, width = width, height = height,
+ hjust = just$hjust, vjust = just$vjust,
+ gp = gpar(fill = "cornsilk", col = NA)
+ ),
+ pointsGrob(x, y, pch = 20, gp = gpar(col = "gold")),
+ grob
)
+ } else {
+ children <- gList(grob)
}
gTree(
- children = grob,
- vp = vpTree(vp, vpList(child_vp)),
- widths = widths,
- heights = heights,
+ children = children,
+ widths = new_width,
+ heights = new_height,
cl = "titleGrob"
)
}
-#' Create a text grob with the proper location and margins
-#'
-#' `titleGrob()` is called when creating titles and labels for axes, legends,
-#' and facet strips.
-#'
-#' @param label Text to place on the plot. These maybe axis titles, axis labels,
-#' facet strip titles, etc.
-#' @param x,y x and y locations where the text is to be placed.
-#' @param hjust,vjust Horizontal and vertical justification of the text.
-#' @param angle Angle of rotation of the text.
-#' @param gp Additional graphical parameters in a call to `gpar()`.
-#' @param margin Margins around the text. See [margin()] for more
-#' details.
-#' @param margin_x,margin_y Whether or not to add margins in the x/y direction.
-#' @param debug If `TRUE`, aids visual debugging by drawing a solid
-#' rectangle behind the complete text area, and a point where each label
-#' is anchored.
-#'
-#' @noRd
-titleGrob <- function(label, x, y, hjust, vjust, angle = 0, gp = gpar(),
- margin = NULL, margin_x = FALSE, margin_y = FALSE,
- debug = FALSE, check.overlap = FALSE) {
-
- if (is.null(label))
- return(zeroGrob())
-
- # Get text grob, text height, and text width
- grob_details <- title_spec(
- label,
- x = x,
- y = y,
- hjust = hjust,
- vjust = vjust,
- angle = angle,
- gp = gp,
- debug = debug,
- check.overlap = check.overlap
- )
-
- add_margins(
- grob = grob_details$text_grob,
- height = grob_details$text_height,
- width = grob_details$text_width,
- gp = gp,
- margin = margin,
- margin_x = margin_x,
- margin_y = margin_y
- )
-}
-
#' @export
widthDetails.titleGrob <- function(x) {
sum(x$widths)
diff --git a/tests/testthat/_snaps/facet-/left-justified-facet-labels-with-margins.svg b/tests/testthat/_snaps/facet-/left-justified-facet-labels-with-margins.svg
index 5ee270737c..d25d212caa 100644
--- a/tests/testthat/_snaps/facet-/left-justified-facet-labels-with-margins.svg
+++ b/tests/testthat/_snaps/facet-/left-justified-facet-labels-with-margins.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
index 675d65dd25..c3f247ebe5 100644
--- a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
+++ b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/geom-dotplot/bin-y-dodged.svg b/tests/testthat/_snaps/geom-dotplot/bin-y-dodged.svg
index 69382b9e60..f8952cdf9f 100644
--- a/tests/testthat/_snaps/geom-dotplot/bin-y-dodged.svg
+++ b/tests/testthat/_snaps/geom-dotplot/bin-y-dodged.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg
index ec51b6ab15..6c27c29626 100644
--- a/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg
+++ b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/guides/align-facet-labels-facets-horizontal.svg b/tests/testthat/_snaps/guides/align-facet-labels-facets-horizontal.svg
index 84b81e2ba2..525759cff3 100644
--- a/tests/testthat/_snaps/guides/align-facet-labels-facets-horizontal.svg
+++ b/tests/testthat/_snaps/guides/align-facet-labels-facets-horizontal.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/guides/align-facet-labels-facets-vertical.svg b/tests/testthat/_snaps/guides/align-facet-labels-facets-vertical.svg
index c86d890439..d1017d39bb 100644
--- a/tests/testthat/_snaps/guides/align-facet-labels-facets-vertical.svg
+++ b/tests/testthat/_snaps/guides/align-facet-labels-facets-vertical.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/position-stack/area-stacking.svg b/tests/testthat/_snaps/position-stack/area-stacking.svg
index a8a8207726..dea44df744 100644
--- a/tests/testthat/_snaps/position-stack/area-stacking.svg
+++ b/tests/testthat/_snaps/position-stack/area-stacking.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/scales-breaks-labels/character.svg b/tests/testthat/_snaps/scales-breaks-labels/character.svg
index ec7759f0db..71fef7b984 100644
--- a/tests/testthat/_snaps/scales-breaks-labels/character.svg
+++ b/tests/testthat/_snaps/scales-breaks-labels/character.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/scales-breaks-labels/date.svg b/tests/testthat/_snaps/scales-breaks-labels/date.svg
index 67f0fe7f65..d76a0f758a 100644
--- a/tests/testthat/_snaps/scales-breaks-labels/date.svg
+++ b/tests/testthat/_snaps/scales-breaks-labels/date.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/scales-breaks-labels/numeric-exp.svg b/tests/testthat/_snaps/scales-breaks-labels/numeric-exp.svg
index 93049aae99..f7885d961a 100644
--- a/tests/testthat/_snaps/scales-breaks-labels/numeric-exp.svg
+++ b/tests/testthat/_snaps/scales-breaks-labels/numeric-exp.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/custom-strip-elements-can-render.svg b/tests/testthat/_snaps/theme/custom-strip-elements-can-render.svg
index 6afd7491f4..5f850c60fd 100644
--- a/tests/testthat/_snaps/theme/custom-strip-elements-can-render.svg
+++ b/tests/testthat/_snaps/theme/custom-strip-elements-can-render.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/strip-styling.svg b/tests/testthat/_snaps/theme/strip-styling.svg
index 572b8d8af7..0e4ce8e479 100644
--- a/tests/testthat/_snaps/theme/strip-styling.svg
+++ b/tests/testthat/_snaps/theme/strip-styling.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-bw-large.svg b/tests/testthat/_snaps/theme/theme-bw-large.svg
index 31f3838761..148d1a93ca 100644
--- a/tests/testthat/_snaps/theme/theme-bw-large.svg
+++ b/tests/testthat/_snaps/theme/theme-bw-large.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-classic-large.svg b/tests/testthat/_snaps/theme/theme-classic-large.svg
index c203fe649b..4d0c2477ac 100644
--- a/tests/testthat/_snaps/theme/theme-classic-large.svg
+++ b/tests/testthat/_snaps/theme/theme-classic-large.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-dark-large.svg b/tests/testthat/_snaps/theme/theme-dark-large.svg
index 0ca41842c0..9bad950947 100644
--- a/tests/testthat/_snaps/theme/theme-dark-large.svg
+++ b/tests/testthat/_snaps/theme/theme-dark-large.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-gray-large.svg b/tests/testthat/_snaps/theme/theme-gray-large.svg
index e055d00f11..971aeb4eef 100644
--- a/tests/testthat/_snaps/theme/theme-gray-large.svg
+++ b/tests/testthat/_snaps/theme/theme-gray-large.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-light-large.svg b/tests/testthat/_snaps/theme/theme-light-large.svg
index 385756f9d5..727f55ae02 100644
--- a/tests/testthat/_snaps/theme/theme-light-large.svg
+++ b/tests/testthat/_snaps/theme/theme-light-large.svg
@@ -18,7 +18,7 @@
-
+
diff --git a/tests/testthat/_snaps/theme/theme-linedraw-large.svg b/tests/testthat/_snaps/theme/theme-linedraw-large.svg
index 5e0bcaed90..66998cd898 100644
--- a/tests/testthat/_snaps/theme/theme-linedraw-large.svg
+++ b/tests/testthat/_snaps/theme/theme-linedraw-large.svg
@@ -18,7 +18,7 @@
-
+