automatically fill in parameters

Author: teunbrand

R/boilerplates.R

@@ -23,6 +23,31 @@ boilerplate.Geom <- function(x, ..., env = caller_env()) {
     cli::cli_abort("{.arg geom} is a reserved argument.")
   }
 
+  # Fill in values for parameters from draw functions
+  known_params <-
+    unique(c(names(args), fixed_fmls_names, "flipped_aes", x$aesthetics()))
+  missing_params <- setdiff(x$parameters(), known_params)
+  if (length(missing_params) > 0) {
+    draw_args <- ggproto_formals(x$draw_panel)
+    if ("..." %in% names(draw_args)) {
+      draw_args <- ggproto_formals(x$draw_group)
+    }
+    params <- intersect(missing_params, names(draw_args))
+    extra_args <- c(extra_args, params)
+    for (param in params) {
+      if (!identical(draw_args[[param]], quote(expr = ))) {
+        args[param] <- draw_args[param]
+      }
+    }
+    missing_params <- setdiff(missing_params, names(args))
+    if (length(missing_params) > 0) {
+      cli::cli_warn(
+        "In {.fn geom_{geom}}: please consider providing default values for: \\
+        {missing_params}."
+      )
+    }
+  }
+
   # Build function formals
   fmls <- list2(
     mapping  = args$mapping,

R/geom-bar.R

@@ -136,8 +136,4 @@ GeomBar <- ggproto("GeomBar", GeomRect,
 #' ggplot(df, aes(x, y)) + geom_col(just = 0.5)
 #' # Columns begin on the first day of the month
 #' ggplot(df, aes(x, y)) + geom_col(just = 1)
-geom_bar <- boilerplate(
-  GeomBar, stat = "count", position = "stack",
-  just = 0.5, orientation = NA,
-  lineend = "butt", linejoin = "mitre"
-)
+geom_bar <- boilerplate(GeomBar, stat = "count", position = "stack", just = 0.5)

R/geom-bin2d.R

@@ -31,10 +31,7 @@ NULL
 #'
 #' # Or by specifying the width of the bins
 #' d + geom_bin_2d(binwidth = c(0.1, 0.1))
-geom_bin_2d <- boilerplate(
-  GeomTile, stat = "bin2d",
-  lineend = "butt", linejoin = "mitre"
-)
+geom_bin_2d <- boilerplate(GeomTile, stat = "bin2d")
 
 #' @export
 #' @rdname geom_bin_2d

R/geom-col.R

@@ -1,9 +1,6 @@
 #' @export
 #' @rdname geom_bar
-geom_col <- boilerplate(
-  GeomBar, position = "stack",
-  just = 0.5, lineend = "butt", linejoin = "mitre"
-)
+geom_col <- boilerplate(GeomBar, position = "stack", just = 0.5)
 
 #' @rdname ggplot2-ggproto
 #' @format NULL

R/geom-contour.R

@@ -85,16 +85,14 @@ GeomContourFilled <- ggproto("GeomContourFilled", GeomPolygon)
 #' }
 geom_contour <- boilerplate(
   GeomContour, stat = "contour",
-  bins = NULL, binwidth = NULL, breaks = NULL,
-  lineend = "butt", linejoin = "round", linemitre = 10,
-  arrow = NULL, arrow.fill = NULL
+  # Passed to contour stat:
+  bins = NULL, binwidth = NULL, breaks = NULL
 )
 
 #' @rdname geom_contour
 #' @export
 geom_contour_filled <- boilerplate(
   GeomContourFilled, stat = "contour_filled",
-  bins = NULL, binwidth = NULL, breaks = NULL,
-  rule = "evenodd",
-  lineend = "butt", linejoin = "round", linemitre = 10
+  # Passed to contour_filled stat:
+  bins = NULL, binwidth = NULL, breaks = NULL
 )

R/geom-crossbar.R

@@ -93,8 +93,4 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
 
 #' @export
 #' @rdname geom_linerange
-geom_crossbar <- boilerplate(
-  GeomCrossbar,
-  fatten = 2.5, orientation = NA, width = NULL,
-  lineend = "butt", linejoin = "mitre"
-)
+geom_crossbar <- boilerplate(GeomCrossbar)

R/geom-curve.R

@@ -47,9 +47,4 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment,
 #' @inheritParams grid::curveGrob
 #' @export
 #' @rdname geom_segment
-geom_curve <- boilerplate(
-  GeomCurve,
-  curvature = 0.5, angle = 90, ncp = 5,
-  arrow = NULL, arrow.fill = NULL,
-  lineend = "butt"
-)
+geom_curve <- boilerplate(GeomCurve)

R/geom-errorbar.R

@@ -58,7 +58,4 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
 #' @export
 #' @rdname geom_linerange
-geom_errorbar <- boilerplate(
-  GeomErrorbar,
-  orientation = NA, lineend = "butt"
-)
+geom_errorbar <- boilerplate(GeomErrorbar, orientation = NA)

R/geom-errorbarh.R

@@ -69,4 +69,4 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
 #' p +
 #'   geom_point() +
 #'   geom_errorbarh(aes(xmax = resp + se, xmin = resp - se, height = .2))
-geom_errorbarh <- boilerplate(GeomErrorbarh, lineend = "butt")
+geom_errorbarh <- boilerplate(GeomErrorbarh)

R/geom-hex.R

@@ -100,7 +100,4 @@ GeomHex <- ggproto("GeomHex", Geom,
 #' d + geom_hex(binwidth = c(1, 1000))
 #' d + geom_hex(binwidth = c(.1, 500))
 #' }
-geom_hex <- boilerplate(
-  GeomHex, stat = 'binhex',
-  lineend = "butt", linejoin = "mitre", linemitre = 10
-)
+geom_hex <- boilerplate(GeomHex, stat = 'binhex')