WIP: Emit warning if non-constant data columns are dropped by stat transformation.

R/stat-.r

@@ -61,6 +61,10 @@ Stat <- ggproto("Stat",
 
   non_missing_aes = character(),
 
+  # aesthetics that are dropped from the data frame during the
+  # process of the statistical transformation
+  dropped_aes = character(),
+
   setup_params = function(data, params) {
     params
   },
@@ -114,7 +118,22 @@ Stat <- ggproto("Stat",
       )
     }, stats, groups, SIMPLIFY = FALSE)
 
-    rbind_dfs(stats)
+    data_new <- rbind_dfs(stats)
+
+    # The above code will drop columns that are not constant within groups and not
+    # carried over/recreated by the stat. This can produce unexpeted results,
+    # and hence we warn about it.
+    dropped <- base::setdiff(names(data), base::union(self$dropped_aes, names(data_new)))
+    if (length(dropped) > 0) {
+      warn_message <- paste0(
+        length(dropped), " aesthetic(s) dropped during statistical transformation: ",
+        paste0(dropped, collapse = ", "),
+        ".\nDid you forget to define a group aesthetic or to convert a numeric variable ",
+        "into a factor?"
+      )
+      warning(warn_message, call. = FALSE)
+    }
+    data_new
   },
 
   compute_group = function(self, data, scales) {

R/stat-bin.r

@@ -1,8 +1,8 @@
 #' @param binwidth The width of the bins. Can be specified as a numeric value
-#'   or as a function that calculates width from unscaled x. Here, "unscaled x" 
-#'   refers to the original x values in the data, before application of any 
+#'   or as a function that calculates width from unscaled x. Here, "unscaled x"
+#'   refers to the original x values in the data, before application of any
 #'   scale transformation. When specifying a function along with a grouping
-#'   structure, the function will be called once per group. 
+#'   structure, the function will be called once per group.
 #'   The default is to use `bins`
 #'   bins that cover the range of the data. You should always override
 #'   this value, exploring multiple widths to find the best to illustrate the
@@ -147,6 +147,7 @@ StatBin <- ggproto("StatBin", Stat,
   },
 
   default_aes = aes(y = stat(count), weight = 1),
-  required_aes = c("x")
+  required_aes = c("x"),
+  dropped_aes = c("weight")
 )
 

R/stat-bindot.r

@@ -6,6 +6,7 @@ StatBindot <- ggproto("StatBindot", Stat,
   required_aes = "x",
   non_missing_aes = "weight",
   default_aes = aes(y = 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

@@ -44,6 +44,7 @@ stat_boxplot <- function(mapping = NULL, data = NULL,
 StatBoxplot <- ggproto("StatBoxplot", Stat,
   required_aes = c("y"),
   non_missing_aes = "weight",
+  dropped_aes = c("y"),
   setup_data = function(data, params) {
     data$x <- data$x %||% 0
     data <- remove_missing(

R/stat-contour.r

@@ -35,6 +35,7 @@ stat_contour <- function(mapping = NULL, data = NULL,
 StatContour <- ggproto("StatContour", Stat,
   required_aes = c("x", "y", "z"),
   default_aes = aes(order = stat(level)),
+  dropped_aes = c("z"),
 
   compute_group = function(data, scales, bins = NULL, binwidth = NULL,
                            breaks = NULL, complete = FALSE, na.rm = FALSE) {