feat: 'pattern_units' aesthetic

* {ggpattern} now supports the `pattern_units` aesthetic (#81).
  Supported by most "geometry" patterns.
  It sets the `grid::unit()` used by the `pattern_spacing`, `pattern_xoffset`, `pattern_yoffset`,
  and (for the "wave" pattern) the `pattern_frequency` aesthetics.
  Default is "snpc" while "cm" and "inches" are likely alternatives.

closes #81

Author: trevorld

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggpattern
 Type: Package
 Title: 'ggplot2' Pattern Geoms
-Version: 1.1.0-8
+Version: 1.1.0-9
 Authors@R: c(person("Mike", "FC", role = "aut"),
              person("Trevor L.", "Davis", role = c("aut", "cre"),
                     email = "trevor.l.davis@gmail.com",
@@ -19,7 +19,7 @@ Imports:
     ggplot2 (>= 3.5.1),
     glue,
     grid,
-    gridpattern (>= 1.2.0-4),
+    gridpattern (>= 1.2.0-6),
     lifecycle,
     rlang (>= 1.1.3),
     scales,

NAMESPACE

@@ -185,6 +185,10 @@ export(scale_pattern_type_continuous)
 export(scale_pattern_type_discrete)
 export(scale_pattern_type_identity)
 export(scale_pattern_type_manual)
+export(scale_pattern_units_continuous)
+export(scale_pattern_units_discrete)
+export(scale_pattern_units_identity)
+export(scale_pattern_units_manual)
 export(scale_pattern_xoffset_continuous)
 export(scale_pattern_xoffset_discrete)
 export(scale_pattern_xoffset_identity)

NEWS.md

@@ -39,6 +39,12 @@
   (in addition to color strings) (#112).
   Note using gradient/pattern fills will require R (>= 4.2) and a graphics device with support for the gradient/pattern fill feature.
   Use of just color fills should continue to work on a wider variety of R versions and graphics devices.
+* {ggpattern} now supports the `pattern_units` aesthetic (#81).
+  Supported by most "geometry" patterns.
+  It sets the `grid::unit()` used by the `pattern_spacing`, `pattern_xoffset`, `pattern_yoffset`,
+  and (for the "wave" pattern) the `pattern_frequency` aesthetics.
+  Default is "snpc" while "cm" and "inches" are likely alternatives.
+
 * `geom_bin_2d_pattern()` is now an alias for `geom_bin2d_pattern()`.
   This matches `{ggplot2}` which has both `geom_bin_2d()` and `geom_bin2d()`.
 

R/geom-.R

@@ -40,7 +40,8 @@ pattern_aesthetics <- aes(
 
   pattern_grid             = 'square',
   pattern_rot              = 0,
-  pattern_res              = getOption("ggpattern_res", NA)
+  pattern_res              = getOption("ggpattern_res", NA),
+  pattern_units            = 'snpc'
 )
 
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -57,47 +58,51 @@ create_key_pattern_grob <- function(data, params, size, aspect_ratio, boundary_d
   data$size <- data$linewidth %||% data$size %||% 0.5
   lwd <- min(data$size, min(size) / 4) * .pt
 
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  # Convert the width/height of the key into npc sizes
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  key_native_x <- abs(as.numeric(grid::convertWidth (unit(size[1], 'mm'), 'native')))
-  key_native_y <- abs(as.numeric(grid::convertHeight(unit(size[2], 'mm'), 'native')))
-
-  vp <- grid::current.viewport()
-  vp_native_x <- abs(diff(vp$xscale))
-  vp_native_y <- abs(diff(vp$yscale))
-
-
-  key_npc_x <- abs(as.numeric(grid::convertWidth (unit(size[1], 'mm'), 'npc')))
-  key_npc_y <- abs(as.numeric(grid::convertHeight(unit(size[2], 'mm'), 'npc')))
-
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  # What's the overall scale_factor?
-  # The legend is actually drawn in its own viewport with an area of 1x1 npc.
-  # I have to do some fancy scaling to draw the current pattern in this
-  # scaled viewport as currently appears in the full viewport of the plot.
-  # i.e. I need to make the pattern in the legend look like the pattern in the
-  # plot.
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  denom <- sqrt(2) * (1/aspect_ratio) * 9/8
-
-  if (vp_native_x/vp_native_y < aspect_ratio) {
-    scale_factor <- 1/key_npc_x / aspect_ratio / denom
+  if (data$pattern_units == "snpc") {
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      # Convert the width/height of the key into npc sizes
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      key_native_x <- abs(as.numeric(grid::convertWidth (unit(size[1], 'mm'), 'native')))
+      key_native_y <- abs(as.numeric(grid::convertHeight(unit(size[2], 'mm'), 'native')))
+
+      vp <- grid::current.viewport()
+      vp_native_x <- abs(diff(vp$xscale))
+      vp_native_y <- abs(diff(vp$yscale))
+
+
+      key_npc_x <- abs(as.numeric(grid::convertWidth (unit(size[1], 'mm'), 'npc')))
+      key_npc_y <- abs(as.numeric(grid::convertHeight(unit(size[2], 'mm'), 'npc')))
+
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      # What's the overall scale_factor?
+      # The legend is actually drawn in its own viewport with an area of 1x1 npc.
+      # I have to do some fancy scaling to draw the current pattern in this
+      # scaled viewport as currently appears in the full viewport of the plot.
+      # i.e. I need to make the pattern in the legend look like the pattern in the
+      # plot.
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+      denom <- sqrt(2) * (1/aspect_ratio) * 9/8
+
+      if (vp_native_x/vp_native_y < aspect_ratio) {
+        scale_factor <- 1/key_npc_x / aspect_ratio / denom
+      } else {
+        scale_factor <- 1/key_npc_y/denom
+      }
+
+      scale_factor <- scale_factor * data$pattern_key_scale_factor
+
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      # Compensate for box the key is rendered in being different aspect ratios
+      # i.e. theme(legend.key.width  = unit(2, 'cm'),
+      #            legend.key.height = unit(3, 'cm')
+      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      key_aspect_ratio <- key_native_x/key_native_y
+      scale_factor <- scale_factor / key_aspect_ratio
   } else {
-    scale_factor <- 1/key_npc_y/denom
+      scale_factor <- 1.00 * data$pattern_key_scale_factor
   }
 
-  scale_factor <- scale_factor * data$pattern_key_scale_factor
-
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  # Compensate for box the key is rendered in being different aspect ratios
-  # i.e. theme(legend.key.width  = unit(2, 'cm'),
-  #            legend.key.height = unit(3, 'cm')
-  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  key_aspect_ratio <- key_native_x/key_native_y
-  scale_factor <- scale_factor / key_aspect_ratio
-
   this_params <- fill_default_params(data)
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/scale-pattern-auto.R

@@ -1128,6 +1128,64 @@ scale_pattern_rot_discrete <- function(..., range = c(0, 360)) {
     ...
   )
 }
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' @rdname scale_discrete
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+scale_pattern_units_continuous <- function(name = waiver(),
+                                        breaks = waiver(),
+                                        labels = waiver(),
+                                        limits = NULL,
+                                        choices = c('snpc', 'cm', 'inches'),
+                                        trans = deprecated(),
+                                        guide = 'legend',
+                                        ...,
+                                        transform = 'identity') {
+
+  if (is.null(choices)) {
+     abort('scale_pattern_units_continuous(): must specify "choices" argument')
+  }
+  if (lifecycle::is_present(trans)) {
+     lifecycle::deprecate_warn('1.1.1',
+                               'scale_pattern_units_continuous(trans)',
+                               'scale_pattern_units_continuous(transform)')
+     transform <- trans
+  }
+
+  ggplot2::continuous_scale(
+    aesthetics = 'pattern_units',
+    palette    = function(x) choices[as.integer(x * (length(choices) - 1) + 1)],
+    name       = name,
+    breaks     = breaks,
+    labels     = labels,
+    limits     = limits,
+    transform  = transform,
+    guide      = guide,
+    ...)
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' @rdname scale_discrete
+#' @importFrom utils head
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+scale_pattern_units_discrete <- function(..., choices = c('snpc', 'cm', 'inches'), guide = 'legend') {
+  force(range)
+
+  if (is.null(choices)) {
+     abort('scale_pattern_units_discrete(): must specify "choices" argument')
+  }
+
+  ggplot2::discrete_scale(
+    aesthetics = 'pattern_units',
+    palette    = function(n) {
+      idx <- cut(seq(n), length(choices), labels = FALSE, include.lowest = TRUE)
+      choices[idx]
+    },
+    guide = guide,
+    ...
+  )
+}
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #' Create your own discrete scale
 #'
@@ -1342,6 +1400,13 @@ scale_pattern_rot_manual <- function(..., values, breaks = waiver()) {
   manual_scale('pattern_rot', values, breaks, ...)
 }
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' @rdname scale_pattern_manual
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+scale_pattern_units_manual <- function(..., values, breaks = waiver()) {
+  manual_scale('pattern_units', values, breaks, ...)
+}
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #' Use values without scaling
 #'
 #' @param ...,guide See \code{ggplot2} for documentation on identity scales.
@@ -1711,3 +1776,16 @@ scale_pattern_rot_identity <- function(..., guide = 'none') {
     super      = ScaleContinuousIdentity
   )
 }
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' @rdname scale_pattern_identity
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+scale_pattern_units_identity <- function(..., guide = 'none') {
+  discrete_scale(
+    aesthetics = 'pattern_units',
+    palette    = identity_pal(),
+    ...,
+    guide      = guide,
+    super      = ScaleDiscreteIdentity
+  )
+}

data-raw/config.R

@@ -32,4 +32,5 @@ pattern_frequency        |             | continuous | NULL
 pattern_grid             |             | discrete   | c('square', 'hex')
 pattern_res              |             | continuous | NULL
 pattern_rot              |             | continuous | c(0, 360)
+pattern_units            |             | discrete   | c('snpc', 'cm', 'inches')
 ", trim_ws = TRUE, delim = "|")