Merge branch 'main' into minor_breaks

DESCRIPTION

@@ -275,6 +275,7 @@ Collate:
     'utilities-grid.R'
     'utilities-help.R'
     'utilities-matrix.R'
+    'utilities-patterns.R'
     'utilities-resolution.R'
     'utilities-tidy-eval.R'
     'zxx.R'

NAMESPACE

@@ -95,6 +95,10 @@ S3method(makeContext,dotstackGrob)
 S3method(merge_element,default)
 S3method(merge_element,element)
 S3method(merge_element,element_blank)
+S3method(pattern_alpha,GridPattern)
+S3method(pattern_alpha,GridTilingPattern)
+S3method(pattern_alpha,default)
+S3method(pattern_alpha,list)
 S3method(plot,ggplot)
 S3method(predictdf,default)
 S3method(predictdf,glm)
@@ -148,6 +152,8 @@ S3method(widthDetails,zeroGrob)
 export("%+%")
 export("%+replace%")
 export(.data)
+export(.expose_data)
+export(.ignore_data)
 export(.pt)
 export(.stroke)
 export(AxisSecondary)
@@ -354,6 +360,7 @@ export(expr)
 export(facet_grid)
 export(facet_null)
 export(facet_wrap)
+export(fill_alpha)
 export(find_panel)
 export(flip_data)
 export(flipped_names)
@@ -476,6 +483,7 @@ export(new_guide)
 export(old_guide)
 export(panel_cols)
 export(panel_rows)
+export(pattern_alpha)
 export(position_dodge)
 export(position_dodge2)
 export(position_fill)

NEWS.md

@@ -6,6 +6,16 @@
 * (internal) The `ScaleContinuous$get_breaks()` method no longer censors
   the computed breaks.
 
+* Plot scales now ignore `AsIs` objects constructed with `I(x)`, instead of
+  invoking the identity scale. This allows these columns to co-exist with other
+  layers that need a non-identity scale for the same aesthetic. Also, it makes
+  it easy to specify relative positions (@teunbrand, #5142).
+
+* The `fill` aesthetic in many geoms now accepts grid's patterns and gradients.
+  For developers of layer extensions, this feature can be enabled by switching 
+  from `fill = alpha(fill, alpha)` to `fill = fill_alpha(fill, alpha)` when 
+  providing fills to `grid::gpar()` (@teunbrand, #3997).
+
 * The plot's title, subtitle and caption now obey horizontal text margins
   (#5533).
 

R/backports.R

@@ -22,3 +22,26 @@ if (getRversion() < "3.5") {
   isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x
   isTRUE  <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) &&  x
 }
+
+version_unavailable <- function(...) {
+  fun <- as_label(current_call()[[1]])
+  cli::cli_abort("{.fn {fun}} is not available in R version {getRversion()}.")
+}
+
+# Ignore mask argument if on lower R version (<= 4.1)
+viewport <- function(..., mask) grid::viewport(...)
+pattern  <- version_unavailable
+as.mask  <- version_unavailable
+on_load({
+  if ("mask" %in% fn_fmls_names(grid::viewport)) {
+    viewport <- grid::viewport
+  }
+  # Replace version unavailable functions if found
+  if ("pattern" %in% getNamespaceExports("grid")) {
+    pattern <- grid::pattern
+  }
+  if ("as.mask" %in% getNamespaceExports("grid")) {
+    as.mask <- grid::as.mask
+  }
+})
+

R/geom-.R

@@ -126,6 +126,10 @@ Geom <- ggproto("Geom",
       deprecate_soft0("3.4.0", I("Using the `size` aesthetic in this geom"), I("`linewidth` in the `default_aes` field and elsewhere"))
       default_aes$linewidth <- default_aes$size
     }
+    if (is_pattern(params$fill)) {
+      params$fill <- list(params$fill)
+    }
+
     # Fill in missing aesthetics with their defaults
     missing_aes <- setdiff(names(default_aes), names(data))
 

R/geom-boxplot.R

@@ -239,7 +239,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
       colour = data$colour,
       linewidth = data$linewidth,
       linetype = data$linetype,
-      fill = alpha(data$fill, data$alpha),
+      fill = fill_alpha(data$fill, data$alpha),
       group = data$group
     )
 

R/geom-dotplot.R

@@ -294,7 +294,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
                   stackposition = tdata$stackpos, stackdir = stackdir, stackratio = stackratio,
                   default.units = "npc",
                   gp = gpar(col = alpha(tdata$colour, tdata$alpha),
-                            fill = alpha(tdata$fill, tdata$alpha),
+                            fill = fill_alpha(tdata$fill, tdata$alpha),
                             lwd = tdata$stroke, lty = tdata$linetype,
                             lineend = lineend))
     )

R/geom-hex.R

@@ -90,7 +90,7 @@ GeomHex <- ggproto("GeomHex", Geom,
       coords$x, coords$y,
       gp = gpar(
         col = data$colour,
-        fill = alpha(data$fill, data$alpha),
+        fill = fill_alpha(data$fill, data$alpha),
         lwd = data$linewidth * .pt,
         lty = data$linetype,
         lineend = lineend,

R/geom-label.R

@@ -103,7 +103,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
         ),
         rect.gp = gpar(
           col = if (isTRUE(all.equal(label.size, 0))) NA else row$colour,
-          fill = alpha(row$fill, row$alpha),
+          fill = fill_alpha(row$fill, row$alpha),
           lwd = label.size * .pt
         )
       )

R/geom-map.R

@@ -146,7 +146,7 @@ GeomMap <- ggproto("GeomMap", GeomPolygon,
     polygonGrob(coords$x, coords$y, default.units = "native", id = grob_id,
       gp = gpar(
         col = data$colour,
-        fill = alpha(data$fill, data$alpha),
+        fill = fill_alpha(data$fill, data$alpha),
         lwd = data$linewidth * .pt,
         lineend = lineend,
         linejoin = linejoin,

R/geom-point.R

@@ -131,7 +131,7 @@ GeomPoint <- ggproto("GeomPoint", Geom,
         pch = coords$shape,
         gp = gpar(
           col = alpha(coords$colour, coords$alpha),
-          fill = alpha(coords$fill, coords$alpha),
+          fill = fill_alpha(coords$fill, coords$alpha),
           # Stroke is added around the outside of the point
           fontsize = coords$size * .pt + stroke_size * .stroke / 2,
           lwd = coords$stroke * .stroke / 2

R/geom-polygon.R

@@ -132,7 +132,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
           id = munched$group,
           gp = gpar(
             col = first_rows$colour,
-            fill = alpha(first_rows$fill, first_rows$alpha),
+            fill = fill_alpha(first_rows$fill, first_rows$alpha),
             lwd = first_rows$linewidth * .pt,
             lty = first_rows$linetype,
             lineend = lineend,
@@ -163,7 +163,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
           rule = rule,
           gp = gpar(
             col = first_rows$colour,
-            fill = alpha(first_rows$fill, first_rows$alpha),
+            fill = fill_alpha(first_rows$fill, first_rows$alpha),
             lwd = first_rows$linewidth * .pt,
             lty = first_rows$linetype,
             lineend = lineend,

R/geom-raster.R

@@ -102,6 +102,10 @@ GeomRaster <- ggproto("GeomRaster", Geom,
     nrow <- max(y_pos) + 1
     ncol <- max(x_pos) + 1
 
+    if (is.list(data$fill) && is_pattern(data$fill[[1]])) {
+      cli::cli_abort("{.fn {snake_class(self)}} cannot render pattern fills.")
+    }
+
     raster <- matrix(NA_character_, nrow = nrow, ncol = ncol)
     raster[cbind(nrow - y_pos, x_pos + 1)] <- alpha(data$fill, data$alpha)
 

R/geom-rect.R

@@ -59,7 +59,7 @@ GeomRect <- ggproto("GeomRect", Geom,
         just = c("left", "top"),
         gp = gpar(
           col = coords$colour,
-          fill = alpha(coords$fill, coords$alpha),
+          fill = fill_alpha(coords$fill, coords$alpha),
           lwd = coords$linewidth * .pt,
           lty = coords$linetype,
           linejoin = linejoin,

R/geom-ribbon.R

@@ -183,7 +183,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
       munched_poly$x, munched_poly$y, id = munched_poly$id,
       default.units = "native",
       gp = gpar(
-        fill = alpha(aes$fill, aes$alpha),
+        fill = fill_alpha(aes$fill, aes$alpha),
         col = if (is_full_outline) aes$colour else NA,
         lwd = if (is_full_outline) aes$linewidth * .pt else 0,
         lty = if (is_full_outline) aes$linetype else 1,

R/geom-tile.R

@@ -5,7 +5,8 @@
 #' corners (`xmin`, `xmax`, `ymin` and `ymax`), while
 #' `geom_tile()` uses the center of the tile and its size (`x`,
 #' `y`, `width`, `height`). `geom_raster()` is a high
-#' performance special case for when all the tiles are the same size.
+#' performance special case for when all the tiles are the same size, and no
+#' pattern fills are applied.
 #'
 #' @eval rd_aesthetics("geom", "tile", "Note that `geom_raster()` ignores `colour`.")
 #' @inheritParams layer

R/guide-bins.R

@@ -100,6 +100,7 @@ guide_bins <- function(
   ticks.length = unit(0.2, "npc"),
 
   # general
+  position     = NULL,
   direction    = NULL,
   default.unit = "line",
   override.aes = list(),
@@ -121,6 +122,9 @@ guide_bins <- function(
   if (!is.null(title.position)) {
     title.position <- arg_match0(title.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
   if (!is.null(direction)) {
     direction <- arg_match0(direction, c("horizontal", "vertical"))
   }
@@ -169,6 +173,7 @@ guide_bins <- function(
     ticks_length = ticks.length,
 
     # general
+    position = position,
     direction = direction,
     override.aes = rename_aes(override.aes),
     reverse = reverse,

R/guide-colorbar.R

@@ -151,6 +151,7 @@ guide_colourbar <- function(
   draw.llim = TRUE,
 
   # general
+  position = NULL,
   direction = NULL,
   default.unit = "line",
   reverse = FALSE,
@@ -171,6 +172,9 @@ guide_colourbar <- function(
   if (!is.null(title.position)) {
     title.position <- arg_match0(title.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
   if (!is.null(direction)) {
     direction <- arg_match0(direction, c("horizontal", "vertical"))
   }
@@ -240,6 +244,7 @@ guide_colourbar <- function(
     draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)),
 
     # general
+    position = position,
     direction = direction,
     reverse = reverse,
     order = order,

R/guide-custom.R

@@ -43,7 +43,7 @@
 guide_custom <- function(
   grob, width = grobWidth(grob), height = grobHeight(grob),
   title = NULL, title.position = "top", margin = NULL,
-  position = waiver(), order = 0
+  position = NULL, order = 0
 ) {
   check_object(grob, is.grob, "a {.cls grob} object")
   check_object(width, is.unit, "a {.cls unit} object")

R/guide-legend.R

@@ -46,6 +46,8 @@
 #'   object specifying the distance between key-label pairs in the horizontal
 #'   direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both
 #'   (`key.spacing`).
+#' @param position A character string indicating where the legend should be
+#'   placed relative to the plot panels.
 #' @param direction  A character string indicating the direction of the guide.
 #'   One of "horizontal" or "vertical."
 #' @param default.unit A character string indicating [grid::unit()]
@@ -152,6 +154,7 @@ guide_legend <- function(
   key.spacing.y = NULL,
 
   # General
+  position     = NULL,
   direction    = NULL,
   default.unit = "line",
   override.aes = list(),
@@ -187,6 +190,9 @@ guide_legend <- function(
   if (!is.null(label.position)) {
     label.position <- arg_match0(label.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
 
   new_guide(
     # Title
@@ -217,6 +223,7 @@ guide_legend <- function(
     byrow = byrow,
     reverse = reverse,
     order = order,
+    position = position,
 
     # Fixed parameters
     available_aes = "any",