Interpreter/wrapper for gpar() (#5867)

* write wrapper

* use wrapper

* add news bullet

* remove defunct `len0_null()`

Author: teunbrand

NAMESPACE

@@ -422,6 +422,7 @@ export(get_alt_text)
 export(get_element_tree)
 export(get_guide_data)
 export(gg_dep)
+export(ggpar)
 export(ggplot)
 export(ggplotGrob)
 export(ggplot_add)

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* New helper function `ggpar()` to translate ggplot2's interpretation of 
+  graphical parameters to {grid}'s interpretation (@teunbrand, #5866).
+
 # ggplot2 3.5.1
 
 This is a small release focusing on fixing regressions from 3.5.0 and 

R/annotation-logticks.R

@@ -175,14 +175,14 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
         ticks$x_b <- with(data, segmentsGrob(
           x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"),
           y0 = unit(xticks$start, "cm"), y1 = unit(xticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
+          gp = ggpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth)
         ))
       }
       if (grepl("t", sides) && nrow(xticks) > 0) {
         ticks$x_t <- with(data, segmentsGrob(
           x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"),
           y0 = unit(1, "npc") - unit(xticks$start, "cm"), y1 = unit(1, "npc") - unit(xticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
+          gp = ggpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth)
         ))
       }
     }
@@ -213,14 +213,14 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
         ticks$y_l <- with(data, segmentsGrob(
           y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"),
           x0 = unit(yticks$start, "cm"), x1 = unit(yticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
+          gp = ggpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth)
         ))
       }
       if (grepl("r", sides) && nrow(yticks) > 0) {
         ticks$y_r <- with(data, segmentsGrob(
           y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"),
           x0 = unit(1, "npc") - unit(yticks$start, "cm"), x1 = unit(1, "npc") - unit(yticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
+          gp = ggpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth)
         ))
       }
     }

R/annotation-map.R

@@ -95,9 +95,9 @@ GeomAnnotationMap <- ggproto("GeomAnnotationMap", GeomMap,
 
     polygonGrob(coords$x, coords$y, default.units = "native",
       id = grob_id,
-      gp = gpar(
+      gp = ggpar(
         col = data$colour, fill = alpha(data$fill, data$alpha),
-        lwd = data$linewidth * .pt)
+        lwd = data$linewidth)
       )
   },
 

R/coord-radial.R

@@ -326,8 +326,8 @@ CoordRadial <- ggproto("CoordRadial", Coord,
         y = c(Inf, -Inf, -Inf,  Inf)
       )
       background <- coord_munch(self, background, panel_params, is_closed = TRUE)
-      bg_gp <- gpar(
-        lwd = len0_null(bg_element$linewidth * .pt),
+      bg_gp <- ggpar(
+        lwd = bg_element$linewidth,
         col = bg_element$colour, fill = bg_element$fill,
         lty = bg_element$linetype
       )

R/coord-sf.R

@@ -326,9 +326,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     if (inherits(el, "element_blank")) {
       grobs <- list(element_render(theme, "panel.background"))
     } else {
-      line_gp <- gpar(
+      line_gp <- ggpar(
         col = el$colour,
-        lwd = len0_null(el$linewidth * .pt),
+        lwd = el$linewidth,
         lty = el$linetype
       )
       grobs <- c(

R/geom-curve.R

@@ -57,10 +57,10 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
       default.units = "native",
       curvature = curvature, angle = angle, ncp = ncp,
       square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
-      gp = gpar(
+      gp = ggpar(
         col = alpha(trans$colour, trans$alpha),
         fill = alpha(arrow.fill, trans$alpha),
-        lwd = trans$linewidth * .pt,
+        lwd = trans$linewidth,
         lty = trans$linetype,
         lineend = lineend),
       arrow = arrow

R/geom-dotplot.R

@@ -293,9 +293,9 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
       dotstackGrob(stackaxis = stackaxis, x = tdata$x, y = tdata$y, dotdia = dotdianpc,
                   stackposition = tdata$stackpos, stackdir = stackdir, stackratio = stackratio,
                   default.units = "npc",
-                  gp = gpar(col = alpha(tdata$colour, tdata$alpha),
+                  gp = ggpar(col = alpha(tdata$colour, tdata$alpha),
                             fill = fill_alpha(tdata$fill, tdata$alpha),
-                            lwd = tdata$stroke, lty = tdata$linetype,
+                            lwd = tdata$stroke / .pt, lty = tdata$linetype,
                             lineend = lineend))
     )
   },

R/geom-hex.R

@@ -89,10 +89,10 @@ GeomHex <- ggproto("GeomHex", Geom,
 
     ggname("geom_hex", polygonGrob(
       coords$x, coords$y,
-      gp = gpar(
+      gp = ggpar(
         col = data$colour,
         fill = fill_alpha(data$fill, data$alpha),
-        lwd = data$linewidth * .pt,
+        lwd = data$linewidth,
         lty = data$linetype,
         lineend = lineend,
         linejoin = linejoin,

R/geom-label.R

@@ -90,17 +90,17 @@ GeomLabel <- ggproto("GeomLabel", Geom,
         padding = label.padding,
         r = label.r,
         angle = row$angle,
-        text.gp = gpar(
+        text.gp = ggpar(
           col = row$colour,
           fontsize = row$size * size.unit,
           fontfamily = row$family,
           fontface = row$fontface,
           lineheight = row$lineheight
         ),
-        rect.gp = gpar(
+        rect.gp = ggpar(
           col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour,
           fill = fill_alpha(row$fill, row$alpha),
-          lwd = label.size * .pt
+          lwd = label.size
         )
       )
     })
@@ -115,7 +115,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"),
                       angle = NULL, default.units = "npc", name = NULL,
-                      text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) {
+                      text.gp = gpar(), rect.gp = ggpar(fill = "white"), vp = NULL) {
 
   if (length(label) != 1) {
     cli::cli_abort("{.arg label} must be of length 1.")
@@ -130,7 +130,7 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"),
     vp <- viewport(
       angle = angle, x = x, y = y,
       width = unit(0, "cm"), height = unit(0, "cm"),
-      gp = gpar(fontsize = text.gp$fontsize)
+      gp = ggpar(fontsize = text.gp$fontsize)
     )
     x <- unit(rep(0.5, length(x)), "npc")
     y <- unit(rep(0.5, length(y)), "npc")