POC: Alternative way of determining parameters

R/geom-.R

@@ -63,6 +63,8 @@ Geom <- ggproto("Geom",
 
   default_aes = aes(),
 
+  default_params = NULL,
+
   draw_key = draw_key_point,
 
   handle_na = function(self, data, params) {
@@ -79,7 +81,7 @@ Geom <- ggproto("Geom",
     }
 
     # Trim off extra parameters
-    params <- params[intersect(names(params), self$parameters())]
+    params <- filter_args(params, self$draw_panel)
 
     if (nlevels(as.factor(data$PANEL)) > 1L) {
       data_panels <- split(data, data$PANEL)
@@ -96,8 +98,9 @@ Geom <- ggproto("Geom",
 
   draw_panel = function(self, data, panel_params, coord, ...) {
     groups <- split(data, factor(data$group))
+    params <- filter_args(list2(...), self$draw_group)
     grobs <- lapply(groups, function(group) {
-      self$draw_group(group, panel_params, coord, ...)
+      inject(self$draw_group(group, panel_params = panel_params, coord = coord, !!!params))
     })
 
     ggname(snake_class(self), gTree(
@@ -208,6 +211,9 @@ Geom <- ggproto("Geom",
   extra_params = c("na.rm"),
 
   parameters = function(self, extra = FALSE) {
+    if (!is.null(self$default_params)) {
+      return(names(self$default_params))
+    }
     # Look first in draw_panel. If it contains ... then look in draw groups
     panel_args <- names(ggproto_formals(self$draw_panel))
     group_args <- names(ggproto_formals(self$draw_group))

R/geom-boxplot.R

@@ -178,7 +178,13 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   # need to declare `width` here in case this geom is used with a stat that
   # doesn't have a `width` parameter (e.g., `stat_identity`).
-  extra_params = c("na.rm", "width", "orientation", "outliers"),
+  default_params = list(
+    na.rm = FALSE, width = NULL, orientation = NA, outliers = TRUE,
+    lineend = "butt", linejoin = "mitre", fatten = 2, outlier.colour = NULL,
+    outlier.fill = NULL, outlier.shape = NULL, outlier.size = NULL,
+    outlier.stroke = 0.5, outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
+    staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE
+  ),
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params)

R/geom-violin.R

@@ -162,6 +162,7 @@ GeomViolin <- ggproto("GeomViolin", Geom,
     # Needed for coord_polar and such
     newdata <- vec_rbind0(newdata, newdata[1,])
     newdata <- flip_data(newdata, flipped_aes)
+    params <- filter_args(list(...), GeomPolygon$draw_panel)
 
     # Draw quantiles if requested, so long as there is non-zero y range
     if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {
@@ -183,15 +184,15 @@ GeomViolin <- ggproto("GeomViolin", Geom,
       quantile_grob <- if (nrow(both) == 0) {
         zeroGrob()
       } else {
-        GeomPath$draw_panel(both, ...)
+        inject(GeomPath$draw_panel(both, !!!params))
       }
 
       ggname("geom_violin", grobTree(
-        GeomPolygon$draw_panel(newdata, ...),
+        inject(GeomPolygon$draw_panel(newdata, !!!params)),
         quantile_grob)
       )
     } else {
-      ggname("geom_violin", GeomPolygon$draw_panel(newdata, ...))
+      ggname("geom_violin", inject(GeomPolygon$draw_panel(newdata, !!!params)))
     }
   },
 

R/layer.R

@@ -58,8 +58,8 @@
 #'   `NA`, the default, includes if any aesthetics are mapped.
 #'   `FALSE` never includes, and `TRUE` always includes.
 #'   It can also be a named logical vector to finely select the aesthetics to
-#'   display. To include legend keys for all levels, even 
-#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend, 
+#'   display. To include legend keys for all levels, even
+#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend,
 #'   but unobserved levels are omitted.
 #' @param inherit.aes If `FALSE`, overrides the default aesthetics,
 #'   rather than combining with them. This is most useful for helper functions
@@ -360,8 +360,8 @@ Layer <- ggproto("Layer", NULL,
   compute_statistic = function(self, data, layout) {
     if (empty(data))
       return(data_frame0())
-
-    self$computed_stat_params <- self$stat$setup_params(data, self$stat_params)
+    params <- defaults(self$stat_params, self$stat$default_params)
+    self$computed_stat_params <- self$stat$setup_params(data, params)
     data <- self$stat$setup_data(data, self$computed_stat_params)
     self$stat$compute_layer(data, self$computed_stat_params, layout)
   },
@@ -430,7 +430,8 @@ Layer <- ggproto("Layer", NULL,
       c(names(data), names(self$aes_params)),
       snake_class(self$geom)
     )
-    self$computed_geom_params <- self$geom$setup_params(data, c(self$geom_params, self$aes_params))
+    params <- defaults(c(self$geom_params, self$aes_params), self$geom$default_params)
+    self$computed_geom_params <- self$geom$setup_params(data, params)
     self$geom$setup_data(data, self$computed_geom_params)
   },
 

R/stat-.R

@@ -73,6 +73,8 @@ Stat <- ggproto("Stat",
 
   optional_aes = character(),
 
+  default_params = NULL,
+
   setup_params = function(data, params) {
     params
   },
@@ -102,7 +104,7 @@ Stat <- ggproto("Stat",
     )
 
     # Trim off extra parameters
-    params <- params[intersect(names(params), self$parameters())]
+    params <- filter_args(params, self$compute_panel)
 
     args <- c(list(data = quote(data), scales = quote(scales)), params)
     dapply(data, "PANEL", function(data) {
@@ -121,8 +123,11 @@ Stat <- ggproto("Stat",
     if (empty(data)) return(data_frame0())
 
     groups <- split(data, data$group)
+
+    params <- filter_args(list2(...), self$compute_group)
+
     stats <- lapply(groups, function(group) {
-      self$compute_group(data = group, scales = scales, ...)
+      inject(self$compute_group(data = group, scales = scales, !!!params))
     })
 
     # Record columns that are not constant within groups. We will drop them later.
@@ -194,6 +199,10 @@ Stat <- ggproto("Stat",
   # See discussion at Geom$parameters()
   extra_params = "na.rm",
   parameters = function(self, extra = FALSE) {
+    if (!is.null(self$default_params)) {
+      return(names(self$default_params))
+    }
+
     # Look first in compute_panel. If it contains ... then look in compute_group
     panel_args <- names(ggproto_formals(self$compute_panel))
     group_args <- names(ggproto_formals(self$compute_group))

R/stat-summary.R

@@ -181,7 +181,11 @@ stat_summary <- function(mapping = NULL, data = NULL,
 StatSummary <- ggproto("StatSummary", Stat,
   required_aes = c("x", "y"),
 
-  extra_params = c("na.rm", "orientation", "fun.data", "fun.max", "fun.min", "fun.args"),
+  default_params = list(
+    na.rm = FALSE, orientation = NA,
+    fun.data = NULL, fun = NULL, fun.max = NULL, fun.min = NULL,
+    fun.args = list()
+  ),
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params)

R/utilities.R

@@ -901,3 +901,16 @@
   utils::install.packages(pkg)
   is_installed(pkg)
 }
+
+filter_args <- function(args, fun) {
+  fmls <- if (inherits(fun, "ggproto_method")) {
+    names(ggproto_formals(fun))
+  } else {
+    names(formals(fun))
+  }
+  if ("..." %in% fmls) {
+    return(args)
+  }
+  args[intersect(names(args), fmls)]
+}
+