Text size switch (#5260)

* Add `size_unit` parameter

* Write test

* Add NEWS bullet

* snake_case to dot.case

* More text units

* Add test for error message

Author: teunbrand

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* `geom_text()` and `geom_label()` gained a `size.unit` parameter that set the 
+  text size to millimetres, points, centimetres, inches or picas 
+  (@teunbrand, #3799).
+
 * The guide system, as the last remaining chunk of ggplot2, has been rewritten 
   in ggproto. The axes and legends now inherit from a <Guide> class, which makes
   them extensible in the same manner as geoms, stats, facets and coords 

R/geom-label.R

@@ -12,6 +12,7 @@ geom_label <- function(mapping = NULL, data = NULL,
                        label.padding = unit(0.25, "lines"),
                        label.r = unit(0.15, "lines"),
                        label.size = 0.25,
+                       size.unit = "mm",
                        na.rm = FALSE,
                        show.legend = NA,
                        inherit.aes = TRUE) {
@@ -39,6 +40,7 @@ geom_label <- function(mapping = NULL, data = NULL,
       label.padding = label.padding,
       label.r = label.r,
       label.size = label.size,
+      size.unit = size.unit,
       na.rm = na.rm,
       ...
     )
@@ -63,7 +65,8 @@ GeomLabel <- ggproto("GeomLabel", Geom,
                         na.rm = FALSE,
                         label.padding = unit(0.25, "lines"),
                         label.r = unit(0.15, "lines"),
-                        label.size = 0.25) {
+                        label.size = 0.25,
+                        size.unit = "mm") {
     lab <- data$label
     if (parse) {
       lab <- parse_safe(as.character(lab))
@@ -80,6 +83,8 @@ GeomLabel <- ggproto("GeomLabel", Geom,
       label.padding <- rep(label.padding, length.out = 4)
     }
 
+    size.unit <- resolve_text_unit(size.unit)
+
     grobs <- lapply(1:nrow(data), function(i) {
       row <- data[i, , drop = FALSE]
       labelGrob(lab[i],
@@ -91,7 +96,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
         angle = row$angle,
         text.gp = gpar(
           col = row$colour,
-          fontsize = row$size * .pt,
+          fontsize = row$size * size.unit,
           fontfamily = row$family,
           fontface = row$fontface,
           lineheight = row$lineheight

R/geom-text.R

@@ -52,6 +52,9 @@
 #'   the order of the data. Therefore data should be arranged by the label
 #'   column before calling `geom_text()`. Note that this argument is not
 #'   supported by `geom_label()`.
+#' @param size.unit How the `size` aesthetic is interpreted: as millimetres
+#'   (`"mm"`, default), points (`"pt"`), centimetres (`"cm"`), inches (`"in"`),
+#'   or picas (`"pc"`).
 #' @export
 #' @examples
 #' p <- ggplot(mtcars, aes(wt, mpg, label = rownames(mtcars)))
@@ -159,6 +162,7 @@ geom_text <- function(mapping = NULL, data = NULL,
                       nudge_x = 0,
                       nudge_y = 0,
                       check_overlap = FALSE,
+                      size.unit = "mm",
                       na.rm = FALSE,
                       show.legend = NA,
                       inherit.aes = TRUE)
@@ -185,6 +189,7 @@ geom_text <- function(mapping = NULL, data = NULL,
     params = list2(
       parse = parse,
       check_overlap = check_overlap,
+      size.unit = size.unit,
       na.rm = na.rm,
       ...
     )
@@ -206,7 +211,8 @@ GeomText <- ggproto("GeomText", Geom,
   ),
 
   draw_panel = function(data, panel_params, coord, parse = FALSE,
-                        na.rm = FALSE, check_overlap = FALSE) {
+                        na.rm = FALSE, check_overlap = FALSE,
+                        size.unit = "mm") {
     lab <- data$label
     if (parse) {
       lab <- parse_safe(as.character(lab))
@@ -221,14 +227,16 @@ GeomText <- ggproto("GeomText", Geom,
       data$hjust <- compute_just(data$hjust, data$x, data$y, data$angle)
     }
 
+    size.unit <- resolve_text_unit(size.unit)
+
     textGrob(
       lab,
       data$x, data$y, default.units = "native",
       hjust = data$hjust, vjust = data$vjust,
       rot = data$angle,
       gp = gpar(
         col = alpha(data$colour, data$alpha),
-        fontsize = data$size * .pt,
+        fontsize = data$size * size.unit,
         fontfamily = data$family,
         fontface = data$fontface,
         lineheight = data$lineheight
@@ -276,3 +284,15 @@ just_dir <- function(x, tol = 0.001) {
   out[x > 0.5 + tol] <- 3L
   out
 }
+
+resolve_text_unit <- function(unit) {
+  unit <- arg_match0(unit, c("mm", "pt", "cm", "in", "pc"))
+  switch(
+    unit,
+    "mm" = .pt,
+    "cm" = .pt * 10,
+    "in" = 72.27,
+    "pc" = 12,
+    1
+  )
+}

man/geom_text.Rd

@@ -18,6 +18,24 @@ test_that("geom_text() drops missing angles", {
   )
 })
 
+test_that("geom_text() accepts mm and pt size units", {
+  p <- ggplot(data_frame0(x = 1, y = 1, label = "A"), aes(x, y, label = label))
+
+  grob <- layer_grob(p + geom_text(size = 10, size.unit = "mm"))[[1]]
+  expect_equal(grob$gp$fontsize, 10 * .pt)
+
+  grob <- layer_grob(p + geom_text(size = 10, size.unit = "pt"))[[1]]
+  expect_equal(grob$gp$fontsize, 10)
+})
+
+test_that("geom_text() rejects exotic units", {
+  p <- ggplot(data_frame0(x = 1, y = 1, label = "A"), aes(x, y, label = label))
+  expect_error(
+    ggplotGrob(p + geom_text(size = 10, size.unit = "npc")),
+    "must be one of"
+  )
+})
+
 # compute_just ------------------------------------------------------------
 
 test_that("vertical and horizontal positions are equivalent", {