Merge branch 'main' into topepo-main

Author: teunbrand

DESCRIPTION

@@ -44,6 +44,7 @@ Imports:
     vctrs (>= 0.6.0),
     withr (>= 2.5.0)
 Suggests:
+    broom,
     covr,
     dplyr,
     ggplot2movies,
@@ -126,15 +127,15 @@ Collate:
     'facet-grid-.R'
     'facet-null.R'
     'facet-wrap.R'
-    'fortify-lm.R'
     'fortify-map.R'
-    'fortify-multcomp.R'
+    'fortify-models.R'
     'fortify-spatial.R'
     'fortify.R'
     'stat-.R'
     'geom-abline.R'
     'geom-rect.R'
     'geom-bar.R'
+    'geom-tile.R'
     'geom-bin2d.R'
     'geom-blank.R'
     'geom-boxplot.R'
@@ -167,7 +168,6 @@ Collate:
     'geom-smooth.R'
     'geom-spoke.R'
     'geom-text.R'
-    'geom-tile.R'
     'geom-violin.R'
     'geom-vline.R'
     'ggplot2-package.R'

NAMESPACE

@@ -172,6 +172,7 @@ export(GeomAbline)
 export(GeomAnnotationMap)
 export(GeomArea)
 export(GeomBar)
+export(GeomBin2d)
 export(GeomBlank)
 export(GeomBoxplot)
 export(GeomCol)

NEWS.md

@@ -1,5 +1,15 @@
 # ggplot2 (development version)
 
+* In non-orthogonal coordinate systems (`coord_sf()`, `coord_polar()` and 
+  `coord_radial()`), using 'AsIs' variables escape transformation when
+  both `x` and `y` is an 'AsIs' variable (@teunbrand, #6205).
+* The following methods have been deprecated: `fortify.lm()`, `fortify.glht()`,
+  `fortify.confint.glht()`, `fortify.summary.glht()` and `fortify.cld()`. It
+  is recommend to use `broom::augment()` and `broom::tidy()` instead 
+  (@teunbrand, #3816).
+* Custom and raster annotation now respond to scale transformations, and can
+  use AsIs variables for relative placement (@teunbrand based on 
+  @yutannihilation's prior work, #3120)
 * When discrete breaks have names, they'll be used as labels by default 
   (@teunbrand, #6147).
 * The helper function `is.waiver()` is now exported to help extensions to work

R/annotation-custom.R

@@ -70,21 +70,12 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom,
 
   draw_panel = function(data, panel_params, coord, grob, xmin, xmax,
                         ymin, ymax) {
-    if (!inherits(coord, "CoordCartesian")) {
-      cli::cli_abort("{.fn annotation_custom} only works with {.fn coord_cartesian}.")
-    }
-    corners <- data_frame0(
-      x = c(xmin, xmax),
-      y = c(ymin, ymax),
-      .size = 2
+    range <- ranges_annotation(
+      coord, panel_params, xmin, xmax, ymin, ymax,
+      fun = "annotation_custom"
     )
-    data <- coord$transform(corners, panel_params)
-
-    x_rng <- range(data$x, na.rm = TRUE)
-    y_rng <- range(data$y, na.rm = TRUE)
-
-    vp <- viewport(x = mean(x_rng), y = mean(y_rng),
-                   width = diff(x_rng), height = diff(y_rng),
+    vp <- viewport(x = mean(range$x), y = mean(range$y),
+                   width = diff(range$x), height = diff(range$y),
                    just = c("center","center"))
     editGrob(grob, vp = vp, name = paste(grob$name, annotation_id()))
   },
@@ -99,3 +90,21 @@ annotation_id <- local({
     i
   }
 })
+
+ranges_annotation <- function(coord, panel_params, xmin, xmax, ymin, ymax, fun) {
+  if (!inherits(coord, "CoordCartesian")) {
+    cli::cli_abort("{.fn {fun}} only works with {.fn coord_cartesian}.")
+  }
+  data <- data_frame0(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)
+  data <- .ignore_data(data)[[1]]
+  x <- panel_params$x$scale$transform_df(data)
+  data[names(x)] <- x
+  y <- panel_params$y$scale$transform_df(data)
+  data[names(y)] <- y
+  data <- .expose_data(data)[[1]]
+  data <- coord$transform(data, panel_params)
+  list(
+    x = range(data$xmin, data$xmax, na.rm = TRUE),
+    y = range(data$ymin, data$ymax, na.rm = TRUE)
+  )
+}

R/annotation-raster.R

@@ -73,21 +73,13 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom,
 
   draw_panel = function(data, panel_params, coord, raster, xmin, xmax,
                         ymin, ymax, interpolate = FALSE) {
-    if (!inherits(coord, "CoordCartesian")) {
-      cli::cli_abort("{.fn annotation_raster} only works with {.fn coord_cartesian}.")
-    }
-    corners <- data_frame0(
-      x = c(xmin, xmax),
-      y = c(ymin, ymax),
-      .size = 2
+    range <- ranges_annotation(
+      coord, panel_params, xmin, xmax, ymin, ymax,
+      fun = "annotation_raster"
+    )
+    rasterGrob(raster, range$x[1], range$y[1],
+      diff(range$x), diff(range$y), default.units = "native",
+      just = c("left","bottom"), interpolate = interpolate
     )
-    data <- coord$transform(corners, panel_params)
-
-    x_rng <- range(data$x, na.rm = TRUE)
-    y_rng <- range(data$y, na.rm = TRUE)
-
-    rasterGrob(raster, x_rng[1], y_rng[1],
-      diff(x_rng), diff(y_rng), default.units = "native",
-      just = c("left","bottom"), interpolate = interpolate)
   }
 )

R/coord-.R

@@ -284,3 +284,24 @@ check_coord_limits <- function(
   check_object(limits, is_vector, "a vector", arg = arg, call = call)
   check_length(limits, 2L, arg = arg, call = call)
 }
+
+is_transform_immune <- function(data, coord_name) {
+  x <- inherits(data$x, "AsIs")
+  y <- inherits(data$y, "AsIs")
+  if (!(x || y)) {
+    # Neither variable is AsIs, so we need to transform
+    return(FALSE)
+  }
+  if (x && y) {
+    # Both variables are AsIs, so no need to transform
+    return(TRUE)
+  }
+  # We're now in the `xor(x, y)` case
+  var <- if (x) "x" else "y"
+  alt <- if (x) "y" else "x"
+  cli::cli_warn(
+    "{.fn {coord_name}} cannot respect the {.cls AsIs} class of {.var {var}} \\
+    when {.var {alt}} is not also {.cls AsIs}."
+  )
+  return(FALSE)
+}

R/coord-polar.R

@@ -180,6 +180,10 @@ CoordPolar <- ggproto("CoordPolar", Coord,
   },
 
   transform = function(self, data, panel_params) {
+    if (is_transform_immune(data, snake_class(self))) {
+      return(data)
+    }
+
     arc  <- self$start + c(0, 2 * pi)
     dir  <- self$direction
     data <- rename_data(self, data)

R/coord-radial.R

@@ -275,6 +275,10 @@ CoordRadial <- ggproto("CoordRadial", Coord,
   },
 
   transform = function(self, data, panel_params) {
+    if (is_transform_immune(data, snake_class(self))) {
+      return(data)
+    }
+
     data <- rename_data(self, data)
     bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1))
     arc  <- panel_params$arc  %||% c(0, 2 * pi)

R/coord-sf.R

@@ -77,6 +77,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
   },
 
   transform = function(self, data, panel_params) {
+    if (is_transform_immune(data, snake_class(self))) {
+      return(data)
+    }
+
     # we need to transform all non-sf data into the correct coordinate system
     source_crs <- panel_params$default_crs
     target_crs <- panel_params$crs