Check for dropped aesthetics (#4866)

* Check for dropped aesthetics and issue a warning if aesthetics are dropped that shouldn't be. Fixes #3250.

* update documentation

Author: clauswilke

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* ggplot now checks during statistical transformations whether any data 
+  columns were dropped and warns about this. If stats intend to drop
+  data columns they can declare them in the new field `dropped_aes`.
+  (@clauswilke, #3250)
 * Added `stat_align()` to align data without common x-coordinates prior to
   stacking. This is now the default stat for `geom_area()` (@thomasp85, #4850)
 

R/stat-.r

@@ -61,6 +61,11 @@ Stat <- ggproto("Stat",
 
   non_missing_aes = character(),
 
+  # Any aesthetics that are dropped from the data frame during the
+  # statistical transformation should be listed here to suppress a
+  # warning about dropped aesthetics
+  dropped_aes = character(),
+
   optional_aes = character(),
 
   setup_params = function(data, params) {
@@ -125,7 +130,20 @@ Stat <- ggproto("Stat",
       )
     }, stats, groups, SIMPLIFY = FALSE)
 
-    vec_rbind(!!!stats)
+    data_new <- vec_rbind(!!!stats)
+
+    # The above code will drop columns that are not constant within groups and not
+    # carried over/recreated by the stat. This can produce unexpected results,
+    # and hence we warn about it.
+    dropped <- base::setdiff(names(data), base::union(self$dropped_aes, names(data_new)))
+    if (length(dropped) > 0) {
+      cli::cli_warn(c(
+        "The following aesthetics were dropped during statistical transformation: {.field {glue_collapse(dropped, sep = ', ')}}",
+        "i" = "This can happen when ggplot fails to infer the correct grouping structure in the data.",
+        "i" = "Did you forget to specify a {.code group} aesthetic or to convert a numerical variable into a factor?"
+      ))
+    }
+    data_new
   },
 
   compute_group = function(self, data, scales) {

R/stat-bin.r

@@ -29,11 +29,16 @@
 #'   frequency polygons touch 0. Defaults to `FALSE`.
 #' @section Computed variables:
 #' \describe{
-#'   \item{count}{number of points in bin}
-#'   \item{density}{density of points in bin, scaled to integrate to 1}
-#'   \item{ncount}{count, scaled to maximum of 1}
-#'   \item{ndensity}{density, scaled to maximum of 1}
-#'   \item{width}{widths of bins}
+#'   \item{`count`}{number of points in bin}
+#'   \item{`density`}{density of points in bin, scaled to integrate to 1}
+#'   \item{`ncount`}{count, scaled to maximum of 1}
+#'   \item{`ndensity`}{density, scaled to maximum of 1}
+#'   \item{`width`}{widths of bins}
+#' }
+#'
+#' @section Dropped variables:
+#' \describe{
+#'   \item{`weight`}{After binning, weights of individual data points (if supplied) are no longer available.}
 #' }
 #'
 #' @seealso [stat_count()], which counts the number of cases at each x
@@ -167,6 +172,8 @@ StatBin <- ggproto("StatBin", Stat,
 
   default_aes = aes(x = after_stat(count), y = after_stat(count), weight = 1),
 
-  required_aes = "x|y"
+  required_aes = "x|y",
+
+  dropped_aes = "weight" # after statistical transformation, weights are no longer available
 )
 

R/stat-bindot.r

@@ -6,6 +6,7 @@ StatBindot <- ggproto("StatBindot", Stat,
   required_aes = "x",
   non_missing_aes = "weight",
   default_aes = aes(y = after_stat(count)),
+  dropped_aes = c("bin", "bincenter"), # these are temporary variables that are created and then removed by the stat
 
   setup_params = function(data, params) {
     if (is.null(params$binwidth)) {

R/stat-boxplot.r

@@ -47,6 +47,9 @@ stat_boxplot <- function(mapping = NULL, data = NULL,
 StatBoxplot <- ggproto("StatBoxplot", Stat,
   required_aes = c("y|x"),
   non_missing_aes = "weight",
+  # either the x or y aesthetic will get dropped during
+  # statistical transformation, depending on the orientation
+  dropped_aes = c("x", "y"),
   setup_data = function(self, data, params) {
     data <- flip_data(data, params$flipped_aes)
     data$x <- data$x %||% 0

R/stat-contour.r

@@ -18,6 +18,13 @@
 #'  \item{`nlevel`}{Height of contour, scaled to maximum of 1.}
 #'  \item{`piece`}{Contour piece (an integer).}
 #' }
+#'
+#' @section Dropped variables:
+#' \describe{
+#'   \item{`z`}{After contouring, the z values of individual data points are no longer available.}
+#' }
+#'
+#'
 #' @rdname geom_contour
 stat_contour <- function(mapping = NULL, data = NULL,
                          geom = "contour", position = "identity",
@@ -83,6 +90,7 @@ StatContour <- ggproto("StatContour", Stat,
 
   required_aes = c("x", "y", "z"),
   default_aes = aes(order = after_stat(level)),
+  dropped_aes = "z", # z gets dropped during statistical transformation
 
   setup_params = function(data, params) {
     params$z.range <- range(data$z, na.rm = TRUE, finite = TRUE)
@@ -112,6 +120,7 @@ StatContourFilled <- ggproto("StatContourFilled", Stat,
 
   required_aes = c("x", "y", "z"),
   default_aes = aes(order = after_stat(level), fill = after_stat(level)),
+  dropped_aes = "z", # z gets dropped during statistical transformation
 
   setup_params = function(data, params) {
     params$z.range <- range(data$z, na.rm = TRUE, finite = TRUE)

R/stat-density-2d.r

@@ -32,6 +32,15 @@
 #' Contours are calculated for one of the three types of density estimates
 #' obtained before contouring, `density`, `ndensity`, and `count`. Which
 #' of those should be used is determined by the `contour_var` parameter.
+#'
+#' @section Dropped variables:
+#' \describe{
+#'   \item{`z`}{After density estimation, the z values of individual data points are no longer available.}
+#' }
+#'
+#' If contouring is enabled, then similarly `density`, `ndensity`, and `count`
+#' are no longer available after the contouring pass.
+#'
 stat_density_2d <- function(mapping = NULL, data = NULL,
                             geom = "density_2d", position = "identity",
                             ...,
@@ -115,6 +124,10 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
   default_aes = aes(colour = "#3366FF", size = 0.5),
 
   required_aes = c("x", "y"),
+  # because of the chained calculation in compute_panel(),
+  # which calls compute_panel() of a different stat, we declare
+  # dropped aesthetics there
+  dropped_aes = character(0),
 
   extra_params = c(
     "na.rm", "contour", "contour_var",
@@ -145,10 +158,12 @@ StatDensity2d <- ggproto("StatDensity2d", Stat,
     params$z.range <- z.range
 
     if (isTRUE(self$contour_type == "bands")) {
-      contour_stat <- StatContourFilled
+      contour_stat <- ggproto(NULL, StatContourFilled)
     } else { # lines is the default
-      contour_stat <- StatContour
+      contour_stat <- ggproto(NULL, StatContour)
     }
+    # update dropped aes
+    contour_stat$dropped_aes <- c(contour_stat$dropped_aes, "density", "ndensity", "count")
 
     dapply(data, "PANEL", function(data) {
       scales <- layout$get_scales(data$PANEL[1])

R/stat-summary-2d.r

@@ -15,6 +15,11 @@
 #'   \item{x,y}{Location}
 #'   \item{value}{Value of summary statistic.}
 #' }
+#'
+#' @section Dropped variables:
+#' \describe{
+#'   \item{`z`}{After binning, the z values of individual data points are no longer available.}
+#' }
 #' @seealso [stat_summary_hex()] for hexagonal summarization.
 #'   [stat_bin2d()] for the binning options.
 #' @inheritParams layer
@@ -85,6 +90,7 @@ StatSummary2d <- ggproto("StatSummary2d", Stat,
   default_aes = aes(fill = after_stat(value)),
 
   required_aes = c("x", "y", "z"),
+  dropped_aes = "z", # z gets dropped during statistical transformation
 
   compute_group = function(data, scales, binwidth = NULL, bins = 30,
                            breaks = NULL, origin = NULL, drop = TRUE,

R/stat-summary-hex.r

@@ -41,6 +41,8 @@ StatSummaryHex <- ggproto("StatSummaryHex", Stat,
 
   required_aes = c("x", "y", "z"),
 
+  dropped_aes = "z", # z gets dropped during statistical transformation
+
   compute_group = function(data, scales, binwidth = NULL, bins = 30, drop = TRUE,
                            fun = "mean", fun.args = list()) {
     check_installed("hexbin", reason = "for `stat_summary_hex()`")

man/geom_contour.Rd

@@ -19,3 +19,16 @@ test_that("error message is thrown when aesthetics are missing", {
   p <- ggplot(mtcars) + stat_sum()
   expect_error(ggplot_build(p), "x and y$")
 })
+
+test_that("erroneously dropped aesthetics are found and issue a warning", {
+  df <- data_frame(
+    x = c( # arbitrary random numbers
+      0.42986445,  1.11153170, -1.22318013,  0.90982003,
+      0.46454276, -0.42300004, -1.76139834, -0.75060412,
+      0.01635474, -0.63202159
+    ),
+    g = rep(1:2, each = 5)
+  )
+  p <- ggplot(df, aes(x, fill = g)) + geom_density()
+  expect_warning(ggplot_build(p), "aesthetics were dropped")
+})